ACHSA.m

ACHSA ; IHS/ITSC/PMF - ENTER DOCUMENTS (1/8)-(FY,TOS) ;     [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 ; ACHSAFLG flags whether the user is confirming/re-entering data

 ; for the current document.I.e., answered "NO" to 'everything correct'.

 ;

 ;CALLED FROM RTN ACHSAI

 ;

 ;I HATE doing this, but for right now, it's the only answer.

 ;Somehow the user finds a way to enter here so that the basic

 ;vars don't get set.  So we will check for the current fiscal

 ;year and if it is not set, we gonna set it along with the

 ;financial code.   2/28/01   pmf

 I '$D(ACHSCFY) D FY^ACHSUF,FC^ACHSUF,^ACHSVAR

 I $G(ACHSFYWK(DUZ(2),ACHSCFY))="" D FY^ACHSUF,FC^ACHSUF,^ACHSVAR

 ;

 S ACHSACFY=ACHSCFY,ACHSAFLG=""

 ;

 ;Once the registers are closed, do NOT create a new PO

 ;until tomorrow.  022801   pmf

 ;

 ;

 I $P($G(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",+ACHSFYWK(DUZ(2),ACHSCFY),0)),U,2)=DT W !!,*7,"  The Register Has Been CLOSED." S DUOUT=$$DIR^XBDIR("E","Press RETURN...") D END Q

 ;

 ;

A1A ;EP.

 ;

 I $D(ACHSOUT) K ACHSOUT D END Q

 ;

 ;ACHSAFLG IS SET IN ACHSA7

 ;ACHSA7+13    IF "Is this correct?" prompt is answered "NO"

 ;ACHSA7+18    IF funds not available 

 I '$G(ACHSAFLG) S ACHSACFY=ACHSCFY

 E  W !,"CONFIRM / RE-ENTER DATA..." I ACHSACFY'=ACHSCFY W !,"NOTE PRIOR FY!.",!

 ;

 ;IF NOT BLANKET AND NOT SPECIAL OBLIG. AND LINK TO REFERRAL SYSTEM

 ;IS ON

 I '$D(ACHSBLKF),'$D(ACHSSLOC),$$LINK^ACHSBMC S ACHSREF=$G(ACHSREF) D GETREF^ACHSBMC(.ACHSREF) I $D(DUOUT)!$D(DTOUT) D END Q

 ;

FY ; Select FY.

 S ACHSACFY=$$FYSEL^ACHS(1)

 I $D(DTOUT)!$D(DUOUT) D END Q

 I '$D(^ACHS(9,DUZ(2),"FY",ACHSACFY)) W !!,*7,"Fiscal year '",ACHSACFY,"' does not exist. -- TRY AGAIN" G FY

 I ACHSACFY<ACHSCFY W *7 I '$$DIR^XBDIR("Y","Are you sure you want to issue document for a PRIOR FISCAL YEAR","NO","","","",2) G FY

A1C ;

 S ACHSACWK=+ACHSFYWK(DUZ(2),ACHSACFY)

 ;

 D CKB^ACHSUUP                         ;CHECK DCR BALANCES

 ;

 ;IF OUT OF BALANCE QUIT

 I $D(ACHSCNC) S DUOUT=$$DIR^XBDIR("E","Press RETURN...","","","","",1) Q

 ;ASK FOR TYPE OF SERVICE

A3 ;EP.

 S Y=$G(ACHSTYP)

 I Y S Y=$S(Y=1:"Hospital Service",Y=2:"Dental Service",Y=3:"Outpatient Service",1:"")

 S Y=$$DIR^XBDIR("S^43:Hospital Service;57:Dental Service;64:Outpatient Service","Type Of Service",Y,"","","",1)

 G A1A:$D(DUOUT)

 I $D(DTOUT)!('Y) D END Q

 S ACHSTYP=$S(Y=43:1,Y=57:2,Y=64:3,1:"")

 ;

 D ^ACHSA1                          ;DO ENTER DOCUMENT RTN 2 OF 8

 ;

 Q

END ;EP - For fast-out (ACHSQUIT) of initial document.

 K %DT,I,M,P,R,S,Z

 D EN^XBVK("ACHS"),^ACHSVAR

 Q

 ;

ACHSA     ; IHS/ITSC/PMF - ENTER DOCUMENTS (1/8)-(FY,TOS) ;     [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3       ; ACHSAFLG flags whether the user is confirming/re-entering data

 +4       ; for the current document.I.e., answered "NO" to 'everything correct'.

 +5       ;

 +6       ;CALLED FROM RTN ACHSAI

 +7       ;

 +8       ;I HATE doing this, but for right now, it's the only answer.

 +9       ;Somehow the user finds a way to enter here so that the basic

 +10      ;vars don't get set.  So we will check for the current fiscal

 +11      ;year and if it is not set, we gonna set it along with the

 +12      ;financial code.   2/28/01   pmf

 +13       IF '$DATA(ACHSCFY)

               DO FY^ACHSUF

               DO FC^ACHSUF

               DO ^ACHSVAR

 +14       IF $GET(ACHSFYWK(DUZ(2),ACHSCFY))=""

               DO FY^ACHSUF

               DO FC^ACHSUF

               DO ^ACHSVAR

 +15      ;

 +16       SET ACHSACFY=ACHSCFY

           SET ACHSAFLG=""

 +17      ;

 +18      ;Once the registers are closed, do NOT create a new PO

 +19      ;until tomorrow.  022801   pmf

 +20      ;

 +21      ;

 +22       IF $PIECE($GET(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",+ACHSFYWK(DUZ(2),ACHSCFY),0)),U,2)=DT

               WRITE !!,*7,"  The Register Has Been CLOSED."

               SET DUOUT=$$DIR^XBDIR("E","Press RETURN...")

               DO END

               QUIT 

 +23      ;

 +24      ;

A1A       ;EP.

 +1       ;

 +2        IF $DATA(ACHSOUT)

               KILL ACHSOUT

               DO END

               QUIT 

 +3       ;

 +4       ;ACHSAFLG IS SET IN ACHSA7

 +5       ;ACHSA7+13    IF "Is this correct?" prompt is answered "NO"

 +6       ;ACHSA7+18    IF funds not available 

 +7        IF '$GET(ACHSAFLG)

               SET ACHSACFY=ACHSCFY

 +8       IF '$TEST

               WRITE !,"CONFIRM / RE-ENTER DATA..."

               IF ACHSACFY'=ACHSCFY

                   WRITE !,"NOTE PRIOR FY!.",!

 +9       ;

 +10      ;IF NOT BLANKET AND NOT SPECIAL OBLIG. AND LINK TO REFERRAL SYSTEM

 +11      ;IS ON

 +12       IF '$DATA(ACHSBLKF)

               IF '$DATA(ACHSSLOC)

                   IF $$LINK^ACHSBMC

                       SET ACHSREF=$GET(ACHSREF)

                       DO GETREF^ACHSBMC(.ACHSREF)

                       IF $DATA(DUOUT)!$DATA(DTOUT)

                           DO END

                           QUIT 

 +13      ;

FY        ; Select FY.

 +1        SET ACHSACFY=$$FYSEL^ACHS(1)

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)

               DO END

               QUIT 

 +3        IF '$DATA(^ACHS(9,DUZ(2),"FY",ACHSACFY))

               WRITE !!,*7,"Fiscal year '",ACHSACFY,"' does not exist. -- TRY AGAIN"

               GOTO FY

 +4        IF ACHSACFY<ACHSCFY

               WRITE *7

               IF '$$DIR^XBDIR("Y","Are you sure you want to issue document for a PRIOR FISCAL YEAR","NO","","","",2)

                   GOTO FY

A1C       ;

 +1        SET ACHSACWK=+ACHSFYWK(DUZ(2),ACHSACFY)

 +2       ;

 +3       ;CHECK DCR BALANCES

           DO CKB^ACHSUUP

 +4       ;

 +5       ;IF OUT OF BALANCE QUIT

 +6        IF $DATA(ACHSCNC)

               SET DUOUT=$$DIR^XBDIR("E","Press RETURN...","","","","",1)

               QUIT 

 +7       ;ASK FOR TYPE OF SERVICE

A3        ;EP.

 +1        SET Y=$GET(ACHSTYP)

 +2        IF Y

               SET Y=$SELECT(Y=1:"Hospital Service",Y=2:"Dental Service",Y=3:"Outpatient Service",1:"")

 +3        SET Y=$$DIR^XBDIR("S^43:Hospital Service;57:Dental Service;64:Outpatient Service","Type Of Service",Y,"","","",1)

 +4        IF $DATA(DUOUT)

               GOTO A1A

 +5        IF $DATA(DTOUT)!('Y)

               DO END

               QUIT 

 +6        SET ACHSTYP=$SELECT(Y=43:1,Y=57:2,Y=64:3,1:"")

 +7       ;

 +8       ;DO ENTER DOCUMENT RTN 2 OF 8

           DO ^ACHSA1

 +9       ;

 +10       QUIT 

END       ;EP - For fast-out (ACHSQUIT) of initial document.

 +1        KILL %DT,I,M,P,R,S,Z

 +2        DO EN^XBVK("ACHS")

           DO ^ACHSVAR

 +3        QUIT 

 +4       ;