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
