ACHSA44.m

ACHSA44 ; IHS/ADC/GTH - ENTER DOCUMENTS (5/8)-(CAN) ;  

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

 ;

 ;Get the common accounting number and validate.  That's all

 ;

 W !!,"in test version",!!

 ;

 D SETUP

 ;

 ;if the maintenance is not complete, say so and quit

 I 'OK W *7,!!,"CHS COST CENTER TABLE INCOMPLETE.",! W:ACHSF638'="Y" !,"Must have Cost Centers 568, 573, and 574." Q

 ;

 D MAKLST

 I '$D(CANLIST) W *7,!!,"There are no CHS COMMON ACCOUNTING NUMBERs for this facility.",!!,"Please contact your Site Manager.",!,*7 Q

 ;

 D A1

 I $G(ACHSQUIT) Q

 ;

 G ^ACHSA5

 ;

A1 ;EP

 ;get the common accounting number

 ;

 W !!,"Enter last 4 digits of the CAN Number: "

 I ACHSCAN,$D(^ACHS(2,ACHSCAN,0)) S ACHSCC=$P($G(^ACHS(2,ACHSCAN,0)),U,2) W $P($G(^ACHS(2,ACHSCAN,0)),U),"// "

 D READ^ACHSFU

 ;

 ;back from read.  handle the input.

 ;

 ;told to quit?

 G A3^ACHSA:$D(DUOUT)

 I $G(ACHSQUIT) Q

 ;

 ;asked for list

 I Y?1"?".E D LIST G A1

 ;

 ;no response

 I Y="",(ACHSCAN="") W *7,"  Must Have CAN Number" G A1

 ;

 ;if they entered four numbers, put the prefix on the front

 I Y?4N S Y=ACHSPREF_Y

 ;

 ;if they entered a sequence number related to the list, get the code

 I Y?1N.N,$D(CANLIST(Y)) S Y=$P(CANLIST(Y),U,2)

 ;

 ;validate the entry

 D VALID

 ;

 ;not okay?  try again

 I 'OK G A1

 ;

 Q

 ;

VALID ;

 ;validate the input

 ;

 S OK=0

 I '$D(CANLIST(0,Y)) W " Invalid entry" Q

 S ACHSCAN=$P(CANLIST(0,Y),U,2)

 S SEQ=$P(CANLIST(0,Y),U,1),ACHSCC=$P(CANLIST(SEQ),U,3)

 S OK=1

 ;

 Q

 ;

LIST ;

 W !!,"SEQ NO",?10,"FY",?15,"CAN NUMBER",?30,"DESCRIPTION OF THE CAN NUMBER",!,"------",?10,"--",?15,"----------",?30,"-----------------------------"

 S SEQ=0 F  S SEQ=$O(CANLIST(SEQ)) Q:SEQ=""  D

 . S DATA=CANLIST(SEQ)

 . W !,?(3-$L(SEQ)),SEQ,?10,$P(DATA,U,1),?15,$P(DATA,U,2),?30,$P(DATA,U,4)

 . Q

 Q

 ;

SETUP ;

 ;set some basic vars, and check for the minimum

 ;amount of maintenance

 K OK

 ;

 S ACHS573=$O(^ACHS(1,"B",573,0)),ACHS568=$O(^ACHS(1,"B",568,0))

 S ACHS574=$O(^ACHS(1,"B",574,0)),ACHS575=$O(^ACHS(1,"B",575,0))

 S ACHS533=$O(^ACHS(1,"B",533,0))

 S ACHSF638=$P($G(^ACHSF(DUZ(2),0)),U,8)

 ;

 ;set the prefix for the CANs.  This is stored in the AREA data.

 ;if you are not used to these globals, this line looks long and

 ;confusing, but all it's doing is using the facility code as a

 ;subscript to the LOCATION file.  It gets the fourth piece of

 ;that as a subscript to the AREA file, where piece 4 is the prefix

 S ACHSPREF=$P($G(^AUTTAREA($P($G(^AUTTLOC(DUZ(2),0)),U,4),0)),U,4)

 ;

 ;we have to have at least these three cans, unless we are

 ;a 638 facility, in which case we have to have at least one

 ;can, regardless of what it is.

 I ACHS573,ACHS568,ACHS574 S OK=1

 I ACHSF638="Y",$D(^ACHS(1,"B")) S OK=1

 Q

 ;

MAKLST ;

 ;create list of all CAN numbers valid for this case.

 ;validity is decided by several factors, including:

 ;  is the can for this facility, is the year of the can

 ;  fit the year of the service, does the service type

 ;  (in, out, dental) match the service ordered.

 ;

 ;the advantage of this is that if users asks for a list,

 ;we are only showing them valid ones, not all CANs defined.

 ;It also allows for a much simpler and shorter validation

 ;process.

 ;

 K CANLIST N CSTCEN,YEAR,EIN,DATA,OK,SEQ

 ;

 ;look through the Fiscal Year cross reference for CANs to

 ;validate.  The hard part is that some IDIOT changed the

 ;format of the fiscal year from 2 digits to 4, but left

 ;all of the 2 digit ones out there.  So we have to be

 ;ready for either format

 ;

 ;also, we qualify by fiscal year two ways.  if we are using

 ;multi year CANs (site parm 2,24) or if we don't have the

 ;ACHSMGR key, the fiscal year of the can has to be this year

 ;or last.

 ;

 ;the list has two parts.  

 ;    list(0,code1)=seq1_U_...

 ;    list(0,code2)=seq2_U_...

 ;    ... and so on

 ;    list(seq1)=code1_U_...

 ;    ... and so on

 ;

 ; the listing by sequence number is used to write the list to the

 ; screen.  The zero node is used for quick validation of the entry.

 ; the list is defined in detail further down

 ;

 S EIN=0 F  S EIN=$O(^ACHS(2,EIN)) Q:EIN=""  Q:'EIN  D

 . S DATA=$G(^ACHS(2,EIN,0)) I DATA="" Q

 . ;got a can.  first check the facility

 . I $P(DATA,U,3)'=DUZ(2) Q

 . ;is it expired?

 .  I $P(DATA,U,4)'="",($P(DATA,U,4)<DT) Q

 . ;

 . ;if the parm for multi year cans is on, OR

 . ;this user does not have security for ACHSZMGR, AND

 . ;the fiscal year is more than a year ago, stop

 . I $$PARM^ACHS(2,24)="Y"!'($D(^XUSEC("ACHSZMGR",DUZ))) D

 .. ;check the year

 .. Q

 . ;

 . S CSTCEN=$P(DATA,U,2)

 . I ACHSF638'="Y" S OK=0 D MAKLST1 I 'OK Q

 . ;if we got this far, this can is valid

 . ;the canlist has this format

 . ; canlist(0,CAN)           = sequence num^EIN

 . ; canlist(sequence number) = 

 . ;         fy^CAN^cc^ccd^expdate^EIN

 . ;    piece 1         fiscal year

 . ;    piece 2         CAN number

 . ;    piece 3         cost center

 . ;    piece 4         cost center description

 . ;    piece 5         expiration date

 . ;    piece 6         subscript for ^ACHS(2,EIN,0)

 . ;

 . ; not all of these pieces are used right now, but they are

 . ; here so as to be handy

 . ;

 . S CAN=$P(DATA,U,1)

 . S SEQ=$G(SEQ)+1,CANLIST(SEQ)=$G(TYEAR)_U_DATA_U_EIN

 . ; now go get the cost center description and place into piece 4

 . S DATA=$G(^ACHS(1,$P(DATA,U,2),0)),$P(CANLIST(SEQ),U,4)=$P(DATA,U,2)

 . ; finally, set the 0 node

 . S CANLIST(0,CAN)=SEQ_U_EIN

 . Q

 Q

 ;

MAKLST1 ;

 ;if this is not a 638 fac, we come here.  now make sure that

 ;the cost center matches the service type

 I ACHSTYP=1,(CSTCEN'=ACHS573),(CSTCEN'=ACHS575),(CSTCEN'=ACHS533) Q

 I ACHSTYP=2,(CSTCEN'=ACHS568) Q

 I ACHSTYP=3,(CSTCEN=ACHS568) Q

 S OK=1

 Q

ACHSA44   ; IHS/ADC/GTH - ENTER DOCUMENTS (5/8)-(CAN) ;  

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

 +2       ;

 +3       ;Get the common accounting number and validate.  That's all

 +4       ;

 +5        WRITE !!,"in test version",!!

 +6       ;

 +7        DO SETUP

 +8       ;

 +9       ;if the maintenance is not complete, say so and quit

 +10       IF 'OK

               WRITE *7,!!,"CHS COST CENTER TABLE INCOMPLETE.",!

               IF ACHSF638'="Y"

                   WRITE !,"Must have Cost Centers 568, 573, and 574."

               QUIT 

 +11      ;

 +12       DO MAKLST

 +13       IF '$DATA(CANLIST)

               WRITE *7,!!,"There are no CHS COMMON ACCOUNTING NUMBERs for this facility.",!!,"Please contact your Site Manager.",!,*7

               QUIT 

 +14      ;

 +15       DO A1

 +16       IF $GET(ACHSQUIT)

               QUIT 

 +17      ;

 +18       GOTO ^ACHSA5

 +19      ;

A1        ;EP

 +1       ;get the common accounting number

 +2       ;

 +3        WRITE !!,"Enter last 4 digits of the CAN Number: "

 +4        IF ACHSCAN

               IF $DATA(^ACHS(2,ACHSCAN,0))

                   SET ACHSCC=$PIECE($GET(^ACHS(2,ACHSCAN,0)),U,2)

                   WRITE $PIECE($GET(^ACHS(2,ACHSCAN,0)),U),"// "

 +5        DO READ^ACHSFU

 +6       ;

 +7       ;back from read.  handle the input.

 +8       ;

 +9       ;told to quit?

 +10       IF $DATA(DUOUT)

               GOTO A3^ACHSA

 +11       IF $GET(ACHSQUIT)

               QUIT 

 +12      ;

 +13      ;asked for list

 +14       IF Y?1"?".E

               DO LIST

               GOTO A1

 +15      ;

 +16      ;no response

 +17       IF Y=""

               IF (ACHSCAN="")

                   WRITE *7,"  Must Have CAN Number"

                   GOTO A1

 +18      ;

 +19      ;if they entered four numbers, put the prefix on the front

 +20       IF Y?4N

               SET Y=ACHSPREF_Y

 +21      ;

 +22      ;if they entered a sequence number related to the list, get the code

 +23       IF Y?1N.N

               IF $DATA(CANLIST(Y))

                   SET Y=$PIECE(CANLIST(Y),U,2)

 +24      ;

 +25      ;validate the entry

 +26       DO VALID

 +27      ;

 +28      ;not okay?  try again

 +29       IF 'OK

               GOTO A1

 +30      ;

 +31       QUIT 

 +32      ;

VALID     ;

 +1       ;validate the input

 +2       ;

 +3        SET OK=0

 +4        IF '$DATA(CANLIST(0,Y))

               WRITE " Invalid entry"

               QUIT 

 +5        SET ACHSCAN=$PIECE(CANLIST(0,Y),U,2)

 +6        SET SEQ=$PIECE(CANLIST(0,Y),U,1)

           SET ACHSCC=$PIECE(CANLIST(SEQ),U,3)

 +7        SET OK=1

 +8       ;

 +9        QUIT 

 +10      ;

LIST      ;

 +1        WRITE !!,"SEQ NO",?10,"FY",?15,"CAN NUMBER",?30,"DESCRIPTION OF THE CAN NUMBER",!,"------",?10,"--",?15,"----------",?30,"-----------------------------"

 +2        SET SEQ=0

           FOR 

               SET SEQ=$ORDER(CANLIST(SEQ))

               IF SEQ=""

                   QUIT 

               Begin DoDot:1

 +3                SET DATA=CANLIST(SEQ)

 +4                WRITE !,?(3-$LENGTH(SEQ)),SEQ,?10,$PIECE(DATA,U,1),?15,$PIECE(DATA,U,2),?30,$PIECE(DATA,U,4)

 +5                QUIT 

               End DoDot:1

 +6        QUIT 

 +7       ;

SETUP     ;

 +1       ;set some basic vars, and check for the minimum

 +2       ;amount of maintenance

 +3        KILL OK

 +4       ;

 +5        SET ACHS573=$ORDER(^ACHS(1,"B",573,0))

           SET ACHS568=$ORDER(^ACHS(1,"B",568,0))

 +6        SET ACHS574=$ORDER(^ACHS(1,"B",574,0))

           SET ACHS575=$ORDER(^ACHS(1,"B",575,0))

 +7        SET ACHS533=$ORDER(^ACHS(1,"B",533,0))

 +8        SET ACHSF638=$PIECE($GET(^ACHSF(DUZ(2),0)),U,8)

 +9       ;

 +10      ;set the prefix for the CANs.  This is stored in the AREA data.

 +11      ;if you are not used to these globals, this line looks long and

 +12      ;confusing, but all it's doing is using the facility code as a

 +13      ;subscript to the LOCATION file.  It gets the fourth piece of

 +14      ;that as a subscript to the AREA file, where piece 4 is the prefix

 +15       SET ACHSPREF=$PIECE($GET(^AUTTAREA($PIECE($GET(^AUTTLOC(DUZ(2),0)),U,4),0)),U,4)

 +16      ;

 +17      ;we have to have at least these three cans, unless we are

 +18      ;a 638 facility, in which case we have to have at least one

 +19      ;can, regardless of what it is.

 +20       IF ACHS573

               IF ACHS568

                   IF ACHS574

                       SET OK=1

 +21       IF ACHSF638="Y"

               IF $DATA(^ACHS(1,"B"))

                   SET OK=1

 +22       QUIT 

 +23      ;

MAKLST    ;

 +1       ;create list of all CAN numbers valid for this case.

 +2       ;validity is decided by several factors, including:

 +3       ;  is the can for this facility, is the year of the can

 +4       ;  fit the year of the service, does the service type

 +5       ;  (in, out, dental) match the service ordered.

 +6       ;

 +7       ;the advantage of this is that if users asks for a list,

 +8       ;we are only showing them valid ones, not all CANs defined.

 +9       ;It also allows for a much simpler and shorter validation

 +10      ;process.

 +11      ;

 +12       KILL CANLIST

           NEW CSTCEN,YEAR,EIN,DATA,OK,SEQ

 +13      ;

 +14      ;look through the Fiscal Year cross reference for CANs to

 +15      ;validate.  The hard part is that some IDIOT changed the

 +16      ;format of the fiscal year from 2 digits to 4, but left

 +17      ;all of the 2 digit ones out there.  So we have to be

 +18      ;ready for either format

 +19      ;

 +20      ;also, we qualify by fiscal year two ways.  if we are using

 +21      ;multi year CANs (site parm 2,24) or if we don't have the

 +22      ;ACHSMGR key, the fiscal year of the can has to be this year

 +23      ;or last.

 +24      ;

 +25      ;the list has two parts.  

 +26      ;    list(0,code1)=seq1_U_...

 +27      ;    list(0,code2)=seq2_U_...

 +28      ;    ... and so on

 +29      ;    list(seq1)=code1_U_...

 +30      ;    ... and so on

 +31      ;

 +32      ; the listing by sequence number is used to write the list to the

 +33      ; screen.  The zero node is used for quick validation of the entry.

 +34      ; the list is defined in detail further down

 +35      ;

 +36       SET EIN=0

           FOR 

               SET EIN=$ORDER(^ACHS(2,EIN))

               IF EIN=""

                   QUIT 

               IF 'EIN

                   QUIT 

               Begin DoDot:1

 +37               SET DATA=$GET(^ACHS(2,EIN,0))

                   IF DATA=""

                       QUIT 

 +38      ;got a can.  first check the facility

 +39               IF $PIECE(DATA,U,3)'=DUZ(2)

                       QUIT 

 +40      ;is it expired?

 +41               IF $PIECE(DATA,U,4)'=""

                       IF ($PIECE(DATA,U,4)<DT)

                           QUIT 

 +42      ;

 +43      ;if the parm for multi year cans is on, OR

 +44      ;this user does not have security for ACHSZMGR, AND

 +45      ;the fiscal year is more than a year ago, stop

 +46               IF $$PARM^ACHS(2,24)="Y"!'($DATA(^XUSEC("ACHSZMGR",DUZ)))

                       Begin DoDot:2

 +47      ;check the year

 +48                       QUIT 

                       End DoDot:2

 +49      ;

 +50               SET CSTCEN=$PIECE(DATA,U,2)

 +51               IF ACHSF638'="Y"

                       SET OK=0

                       DO MAKLST1

                       IF 'OK

                           QUIT 

 +52      ;if we got this far, this can is valid

 +53      ;the canlist has this format

 +54      ; canlist(0,CAN)           = sequence num^EIN

 +55      ; canlist(sequence number) = 

 +56      ;         fy^CAN^cc^ccd^expdate^EIN

 +57      ;    piece 1         fiscal year

 +58      ;    piece 2         CAN number

 +59      ;    piece 3         cost center

 +60      ;    piece 4         cost center description

 +61      ;    piece 5         expiration date

 +62      ;    piece 6         subscript for ^ACHS(2,EIN,0)

 +63      ;

 +64      ; not all of these pieces are used right now, but they are

 +65      ; here so as to be handy

 +66      ;

 +67               SET CAN=$PIECE(DATA,U,1)

 +68               SET SEQ=$GET(SEQ)+1

                   SET CANLIST(SEQ)=$GET(TYEAR)_U_DATA_U_EIN

 +69      ; now go get the cost center description and place into piece 4

 +70               SET DATA=$GET(^ACHS(1,$PIECE(DATA,U,2),0))

                   SET $PIECE(CANLIST(SEQ),U,4)=$PIECE(DATA,U,2)

 +71      ; finally, set the 0 node

 +72               SET CANLIST(0,CAN)=SEQ_U_EIN

 +73               QUIT 

               End DoDot:1

 +74       QUIT 

 +75      ;

MAKLST1   ;

 +1       ;if this is not a 638 fac, we come here.  now make sure that

 +2       ;the cost center matches the service type

 +3        IF ACHSTYP=1

               IF (CSTCEN'=ACHS573)

                   IF (CSTCEN'=ACHS575)

                       IF (CSTCEN'=ACHS533)

                           QUIT 

 +4        IF ACHSTYP=2

               IF (CSTCEN'=ACHS568)

                   QUIT 

 +5        IF ACHSTYP=3

               IF (CSTCEN=ACHS568)

                   QUIT 

 +6        SET OK=1

 +7        QUIT