ACDPCCL5 ;IHS/ADC/EDE/KML - PCC LINK;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
GENLINK ; EP-GENERATE PCC LINK
;W !,"Generating PCC link"
D ECHK
I $G(ACDQUIT) D VSERROR Q
D @ACDEV("TYPE")
D EOJ
Q
;
ECHK ;ERROR CHECK
S ACDQUIT=""
I '$D(ACDEV) S ACDQUIT=4 Q ; no array defined
F X="CLINIC","LOCATION","PAT","POV","PRI PROV","SITE TYPE","SVC CAT","TYPE","V DATE","VISIT" D Q:$G(ACDQUIT)
. S X=""""_X_""""
. S:X["POV" X=X_",1"
. I '$D(@("ACDEV("_X_")")) S ACDQUIT=5 Q ; required var missing
. I $G(@("ACDEV("_X_")"))="" S ACDQUIT=6 Q ; required var null
. Q
Q:$G(ACDQUIT)
I "AED"'[ACDEV("TYPE") S ACDQUIT=7 Q ; no appropriate type
Q
;
VSERROR ;
S ACDFILE="CDMIS VISIT"
S ACDIEN=$G(ACDEV("VISIT"))
S ACDERR="VE"_ACDQUIT,ACDERR=$P($T(@ACDERR),";;",2)
W !!,$G(IORVON)_"Notify your supervisor that the PCC LINK failed with the following error:",!,ACDFILE,"-",ACDERR_$G(IORVOFF),!!
D PAUSE^ACDDEU
Q
;
VE2 ;;inability to create visit
VE3 ;;invalid visit parameters (date, location etc.)
VE4 ;;ACDEV array not passed
VE5 ;;Required variable not passed
VE6 ;;Required variable is null
VE7 ;;No appropriate type (i.e., A,E,D)
VE21 ;;No activity location passed. No Location determined.
VE22 ;;No IHS Location for HOME in CDMIS SITE PARAMETER File.
VE23 ;;No IHS Location for OTHER in CDMIS SITE PARAMETER File.
VE24 ;;No Location of Encounter when Activity location is Hospital/Clinic.
VE27 ;;No Location of Encounter for OFFICE in CDMIS SITE PARAMETER file.
VE28 ;;Error attempting to modify visit
;
A ; ADD LOGIC
I ACDEV("TC")="CS" D GENLCS Q
S ACDDAY=1 ; ctls 2100 ien in CDMIS visit
D ADDVISIT
Q
;
E ; EDIT LOGIC
W !!,$G(IORVON)_"Logic error at E^ACDPCCL5 - Notify programmer!"_$G(IORVOFF),!!
D PAUSE^ACDDEU
Q
;
GENLCS ; ADD CS VISITS
S ACDCSDTE=0
F S ACDCSDTE=$O(ACDEV("PROC",ACDCSDTE)) Q:ACDCSDTE="" D
. S ACDEV("V DATE")=ACDCSDTE
. S ACDLOC=0
. F S ACDLOC=$O(ACDEV("PROC",ACDCSDTE,ACDLOC)) Q:ACDLOC="" D
.. S ACDEV("CS LOC")=ACDEV("PROC",ACDCSDTE,ACDLOC,"CS LOC")
.. S X=$G(ACDEV("PROC",ACDCSDTE,ACDLOC,"PCC LOC"))
.. S:X ACDEV("LOCATION")=X
.. S ACDDAY=+$E(ACDCSDTE,6,7)
.. D ADDVISIT
.. Q
. Q
Q
;
ADDVISIT ; ADD ONE PCC VISIT
D VISIT ; set up and create visit
I $G(ACDQUIT) Q
D ^APCDALV ; create visit
I $D(APCDALVR("ACDAFLG")) S ACDQUIT=APCDALVR("ACDAFLG") D VSERROR Q
S APCDVSIT=APCDALVR("APCDVSIT")
; set PCC visit ien into CDMIS visit
S X=ACDDAY,DA(1)=ACDEV("VISIT"),DIC="^ACDVIS("_DA(1)_",21,",DIC(0)="L",DIC("DR")=".02////"_APCDVSIT_";.03////"_ACDEV("LOCATION"),DIC("P")=$P(^DD(9002172.1,2100,0),U,2)
D FILE^ACDFMC
I Y<0 D ERROR^ACDPCCL("Adding of PCC VISIT LINKAGE to CDMIS VISIT failed",3) Q
S ACD21IEN=+Y
D VFILES^ACDPCCL6 ; go add v file entries for this visit
Q
;
VISIT ;
D KILL
S APCDALVR("AUPNTALK")=""
S APCDALVR("APCDAUTO")=""
S:ACDEV("TYPE")="A" APCDALVR("APCDADD")=""
S APCDALVR("APCDANE")=""
S APCDALVR("APCDPAT")=ACDEV("PAT")
S (APCDALVR("APCDDATE"),APCDDATK)=ACDEV("V DATE")
S APCDALVR("APCDLOC")=ACDEV("LOCATION")
S APCDALVR("APCDTYPE")=ACDEV("SITE TYPE")
S APCDALVR("APCDCAT")=ACDEV("SVC CAT")
S APCDALVR("APCDCLN")=ACDEV("CLINIC")
S APCDALVR("APCDAPPT")="U"
Q
;
KILL ;
K APCDAFLG,APCDALVR,APCDANE,APCDAPPT,APCDATMP,APCDAUTO
K APCDCAT,APCDCLN
K APCDLOC
K APCDOLOC
K APCDPAT
K APCDTAT,APCDTLOU,APCDTNQ,APCDTPOV,ACDTPRO,ACDTPRV,APCDTPS,APCDTTOP,APCDTYPE
K AUPNTALK
Q
;
EOJ ;
D KILL
K ACD21IEN,ACDCSDTE,ACDDAY,ACDERR,ACDFILE,ACDIEN,ACDLOC,ACDQUIT
Q
ACDPCCL5 ;IHS/ADC/EDE/KML - PCC LINK;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
GENLINK ; EP-GENERATE PCC LINK
+1 ;W !,"Generating PCC link"
+2 DO ECHK
+3 IF $GET(ACDQUIT)
DO VSERROR
QUIT
+4 DO @ACDEV("TYPE")
+5 DO EOJ
+6 QUIT
+7 ;
ECHK ;ERROR CHECK
+1 SET ACDQUIT=""
+2 ; no array defined
IF '$DATA(ACDEV)
SET ACDQUIT=4
QUIT
+3 FOR X="CLINIC","LOCATION","PAT","POV","PRI PROV","SITE TYPE","SVC CAT","TYPE","V DATE","VISIT"
Begin DoDot:1
+4 SET X=""""_X_""""
+5 IF X["POV"
SET X=X_",1"
+6 ; required var missing
IF '$DATA(@("ACDEV("_X_")"))
SET ACDQUIT=5
QUIT
+7 ; required var null
IF $GET(@("ACDEV("_X_")"))=""
SET ACDQUIT=6
QUIT
+8 QUIT
End DoDot:1
IF $GET(ACDQUIT)
QUIT
+9 IF $GET(ACDQUIT)
QUIT
+10 ; no appropriate type
IF "AED"'[ACDEV("TYPE")
SET ACDQUIT=7
QUIT
+11 QUIT
+12 ;
VSERROR ;
+1 SET ACDFILE="CDMIS VISIT"
+2 SET ACDIEN=$GET(ACDEV("VISIT"))
+3 SET ACDERR="VE"_ACDQUIT
SET ACDERR=$PIECE($TEXT(@ACDERR),";;",2)
+4 WRITE !!,$GET(IORVON)_"Notify your supervisor that the PCC LINK failed with the following error:",!,ACDFILE,"-",ACDERR_$GET(IORVOFF),!!
+5 DO PAUSE^ACDDEU
+6 QUIT
+7 ;
VE2 ;;inability to create visit
VE3 ;;invalid visit parameters (date, location etc.)
VE4 ;;ACDEV array not passed
VE5 ;;Required variable not passed
VE6 ;;Required variable is null
VE7 ;;No appropriate type (i.e., A,E,D)
VE21 ;;No activity location passed. No Location determined.
VE22 ;;No IHS Location for HOME in CDMIS SITE PARAMETER File.
VE23 ;;No IHS Location for OTHER in CDMIS SITE PARAMETER File.
VE24 ;;No Location of Encounter when Activity location is Hospital/Clinic.
VE27 ;;No Location of Encounter for OFFICE in CDMIS SITE PARAMETER file.
VE28 ;;Error attempting to modify visit
+1 ;
A ; ADD LOGIC
+1 IF ACDEV("TC")="CS"
DO GENLCS
QUIT
+2 ; ctls 2100 ien in CDMIS visit
SET ACDDAY=1
+3 DO ADDVISIT
+4 QUIT
+5 ;
E ; EDIT LOGIC
+1 WRITE !!,$GET(IORVON)_"Logic error at E^ACDPCCL5 - Notify programmer!"_$GET(IORVOFF),!!
+2 DO PAUSE^ACDDEU
+3 QUIT
+4 ;
GENLCS ; ADD CS VISITS
+1 SET ACDCSDTE=0
+2 FOR
SET ACDCSDTE=$ORDER(ACDEV("PROC",ACDCSDTE))
IF ACDCSDTE=""
QUIT
Begin DoDot:1
+3 SET ACDEV("V DATE")=ACDCSDTE
+4 SET ACDLOC=0
+5 FOR
SET ACDLOC=$ORDER(ACDEV("PROC",ACDCSDTE,ACDLOC))
IF ACDLOC=""
QUIT
Begin DoDot:2
+6 SET ACDEV("CS LOC")=ACDEV("PROC",ACDCSDTE,ACDLOC,"CS LOC")
+7 SET X=$GET(ACDEV("PROC",ACDCSDTE,ACDLOC,"PCC LOC"))
+8 IF X
SET ACDEV("LOCATION")=X
+9 SET ACDDAY=+$EXTRACT(ACDCSDTE,6,7)
+10 DO ADDVISIT
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
ADDVISIT ; ADD ONE PCC VISIT
+1 ; set up and create visit
DO VISIT
+2 IF $GET(ACDQUIT)
QUIT
+3 ; create visit
DO ^APCDALV
+4 IF $DATA(APCDALVR("ACDAFLG"))
SET ACDQUIT=APCDALVR("ACDAFLG")
DO VSERROR
QUIT
+5 SET APCDVSIT=APCDALVR("APCDVSIT")
+6 ; set PCC visit ien into CDMIS visit
+7 SET X=ACDDAY
SET DA(1)=ACDEV("VISIT")
SET DIC="^ACDVIS("_DA(1)_",21,"
SET DIC(0)="L"
SET DIC("DR")=".02////"_APCDVSIT_";.03////"_ACDEV("LOCATION")
SET DIC("P")=$PIECE(^DD(9002172.1,2100,0),U,2)
+8 DO FILE^ACDFMC
+9 IF Y<0
DO ERROR^ACDPCCL("Adding of PCC VISIT LINKAGE to CDMIS VISIT failed",3)
QUIT
+10 SET ACD21IEN=+Y
+11 ; go add v file entries for this visit
DO VFILES^ACDPCCL6
+12 QUIT
+13 ;
VISIT ;
+1 DO KILL
+2 SET APCDALVR("AUPNTALK")=""
+3 SET APCDALVR("APCDAUTO")=""
+4 IF ACDEV("TYPE")="A"
SET APCDALVR("APCDADD")=""
+5 SET APCDALVR("APCDANE")=""
+6 SET APCDALVR("APCDPAT")=ACDEV("PAT")
+7 SET (APCDALVR("APCDDATE"),APCDDATK)=ACDEV("V DATE")
+8 SET APCDALVR("APCDLOC")=ACDEV("LOCATION")
+9 SET APCDALVR("APCDTYPE")=ACDEV("SITE TYPE")
+10 SET APCDALVR("APCDCAT")=ACDEV("SVC CAT")
+11 SET APCDALVR("APCDCLN")=ACDEV("CLINIC")
+12 SET APCDALVR("APCDAPPT")="U"
+13 QUIT
+14 ;
KILL ;
+1 KILL APCDAFLG,APCDALVR,APCDANE,APCDAPPT,APCDATMP,APCDAUTO
+2 KILL APCDCAT,APCDCLN
+3 KILL APCDLOC
+4 KILL APCDOLOC
+5 KILL APCDPAT
+6 KILL APCDTAT,APCDTLOU,APCDTNQ,APCDTPOV,ACDTPRO,ACDTPRV,APCDTPS,APCDTTOP,APCDTYPE
+7 KILL AUPNTALK
+8 QUIT
+9 ;
EOJ ;
+1 DO KILL
+2 KILL ACD21IEN,ACDCSDTE,ACDDAY,ACDERR,ACDFILE,ACDIEN,ACDLOC,ACDQUIT
+3 QUIT
