- ACDPCCLS ;IHS/ADC/EDE/KML - GEN PCC LINK/HC;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;
- ; This routine generates a PCC link or prints a hardcopy from a
- ; patient's CDMIS visit.
- ;
- START ;
- NEW ACDFHCP,ACDFPCC
- D INIT
- I ACDQ D EOJ Q
- D MAIN
- Q
- ;
- INIT ;
- D:'$D(ACD6DIG) ^ACD
- S ACDQ=1
- S DIR(0)="SO^1:PCC LINK;2:HARDCOPY",DIR("A")="Generate PCC link or hardcopy",DIR("B")="2" K DA D ^DIR K DIR
- Q:$D(DIRUT)
- S ACDOPT=Y
- S (ACDFHCP,ACDFPCC)=0
- S:ACDOPT=1 ACDFPCC=1
- S:ACDOPT=2 ACDFHCP=1
- I ACDFPCC S X=1 D ^ACDPCCLC I '$D(X) H 3 Q
- S ACDMODE="A" ; ***** ADD, EDIT, or DELETE *****
- S ACDQ=0
- Q
- ;
- HCP ; EP-GENERATE HARDCOPY FOR SELECTED PATIENTS/VISITS
- ;//option file
- NEW ACDFHCP,ACDFPCC
- S ACDFPCC=0
- S ACDFHCP=1,ACDMODE="A",ACDQ=0
- D MAIN
- Q
- ;
- MAIN ;
- F D PATLOOP Q:ACDQ
- D EOJ
- Q
- ;
- PATLOOP ; DISPLAY PATIENTS UNTIL DONE
- D GETPAT
- Q:ACDQ
- D GETVSITS^ACDDEU ; gather all visits for patient
- Q:ACDQ
- D SELECT ; select visit to display
- Q:ACDQ
- D GENOUTP ; print hardcopy or gen pcc link
- Q
- ;
- GETPAT ; GET PATIENT
- S ACDQ=1
- S AUPNLK("ALL")=1
- S DIC="^AUPNPAT(",DIC(0)="AEMQ",DIC("S")="I $D(^ACDVIS(""D"",Y))" D DIC^ACDFMC
- K AUPNLK("ALL")
- Q:Y<0
- S ACDDFNP=+Y,ACDDFN=$P(^DPT(ACDDFNP,0),U)
- S ACDQ=0
- Q
- ;
- SELECT ; SELECT A CDMIS VISIT
- S ACDQ=1
- W !
- S ACDVIEN=0
- K ACDVLST
- I $O(^TMP("ACD",$J,"VISITS",0))="" W !,"----------",!,"No CDMIS visits!",!,"----------",! Q
- S ACDDTLOW=0,ACDDTHI=9999999
- I ACDVCNT>20 D GETDTRNG Q:ACDQ W !
- S ACDQ=1
- W !
- S ACDLC=0
- S ACDX=ACDDTLOW S:ACDX>0 ACDX=ACDX-1
- F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:ACDX="" I ACDX'<ACDDTLOW,ACDX'>ACDDTHI S ACDY=0 F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D Q:ACDQ
- . S ACDQ=0
- . S ACDLC=ACDLC+1
- . S ACDVLST(ACDLC)=ACDY
- . S DIC="9002172.1",DA=ACDY,DR=".01;1;3;5",DIQ="ACDPDD("
- . D DIQ1^ACDFMC
- . W ACDLC,?5,ACDPDD(9002172.1,ACDY,.01),?18," - ",ACDPDD(9002172.1,ACDY,1),"/",ACDPDD(9002172.1,ACDY,5)," ",ACDPDD(9002172.1,ACDY,3),!
- . K ACDPDD
- . I '(ACDLC#20) D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1
- . Q
- S ACDQ=1
- I 'ACDLC W !,"No visits in date range",! Q
- S DIR(0)="NO^1:"_ACDLC,DIR("A")="Select one of the listed visits" K DA D ^DIR K DIR
- S:Y ACDVIEN=ACDVLST(Y)
- K ACDLC,ACDVLST
- Q:'ACDVIEN
- S ACDQ=0
- Q
- ;
- GETDTRNG ; GET DATE RANGE FOR VISIT
- S ACDQ=1
- S ACDDTLOW=$O(^TMP("ACD",$J,"VISITS",0)),ACDDTHI=$O(^TMP("ACD",$J,"VISITS","Z"),-1)
- W !,"Patient has ",ACDVCNT," visits between ",$$FMTE^XLFDT(ACDDTLOW,"1")," and ",$$FMTE^XLFDT(ACDDTHI,"1"),".",!,"Enter date range of desired visit.",!
- S DIR(0)="DO^::E",DIR("A")="Enter beginning date" K DA D ^DIR K DIR
- Q:'Y
- S ACDDTLOW=Y
- S DIR(0)="D^"_Y_"::E",DIR("A")="Enter ending date",DIR("B")=X K DA D ^DIR K DIR
- Q:$D(DIRUT)
- S ACDDTHI=Y
- S ACDQ=0
- Q
- ;
- GENOUTP ; EP - PRINT HARDCOPY OR GENERATE PCC LINK FOR CDMIS VISIT
- I ACDFPCC,$O(^ACDVIS(ACDVIEN,21,0)) W !!,"This visit already has an associated PCC visit!",! Q
- S X=$P(^ACDVIS(ACDVIEN,0),U,4)
- I X'="IN",X'="RE",X'="FU",X'="IR",X'="OT",X'="TD",X'="CS" W !,"INVALID TYPE CONTACT",!
- E S ACDCONT=X D @("SET"_ACDCONT)
- I 'ACDQ S ACDPCCLS=1 D VISIT^ACDPCCL K ACDPCCLS
- Q
- ;
- SETIN ; INITIAL
- D SETIIF
- Q
- ;
- SETRE ; REOPEN
- D SETIIF
- Q
- ;
- SETFU ; FOLLOWUP
- D SETIIF
- Q
- ;
- SETIIF ; HARDCOPY FROM IIF ENTRY
- S ACDQ=1
- K ACDPCCL
- S Y=$O(^ACDIIF("C",ACDVIEN,0))
- Q:'Y
- S ACDPCCL(ACDDFNP,ACDVIEN,"IIF",Y)=""
- S ACDPCCL(ACDDFNP,ACDVIEN)=""
- S ACDQ=0
- Q
- ;
- SETTD ; HARDCOPY FROM TDC ENTRY
- S ACDQ=1
- K ACDPCCL
- S Y=$O(^ACDTDC("C",ACDVIEN,0))
- Q:'Y
- S ACDPCCL(ACDDFNP,ACDVIEN,"TDC",Y)=""
- S ACDPCCL(ACDDFNP,ACDVIEN)=""
- S ACDQ=0
- Q
- ;
- SETCS ; HARDCOPY OR PCC LINK FROM CLIENT SERVICES
- S ACDY=0
- F S ACDY=$O(^ACDCS("C",ACDVIEN,ACDY)) Q:'ACDY D
- . S ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDY)=""
- . Q
- Q
- ;
- EOJ ;
- K ACDEV,ACDPCCL
- D ^ACDKILL
- Q
- ACDPCCLS ;IHS/ADC/EDE/KML - GEN PCC LINK/HC;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;
- +3 ; This routine generates a PCC link or prints a hardcopy from a
- +4 ; patient's CDMIS visit.
- +5 ;
- START ;
- +1 NEW ACDFHCP,ACDFPCC
- +2 DO INIT
- +3 IF ACDQ
- DO EOJ
- QUIT
- +4 DO MAIN
- +5 QUIT
- +6 ;
- INIT ;
- +1 IF '$DATA(ACD6DIG)
- DO ^ACD
- +2 SET ACDQ=1
- +3 SET DIR(0)="SO^1:PCC LINK;2:HARDCOPY"
- SET DIR("A")="Generate PCC link or hardcopy"
- SET DIR("B")="2"
- KILL DA
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- QUIT
- +5 SET ACDOPT=Y
- +6 SET (ACDFHCP,ACDFPCC)=0
- +7 IF ACDOPT=1
- SET ACDFPCC=1
- +8 IF ACDOPT=2
- SET ACDFHCP=1
- +9 IF ACDFPCC
- SET X=1
- DO ^ACDPCCLC
- IF '$DATA(X)
- HANG 3
- QUIT
- +10 ; ***** ADD, EDIT, or DELETE *****
- SET ACDMODE="A"
- +11 SET ACDQ=0
- +12 QUIT
- +13 ;
- HCP ; EP-GENERATE HARDCOPY FOR SELECTED PATIENTS/VISITS
- +1 ;//option file
- +2 NEW ACDFHCP,ACDFPCC
- +3 SET ACDFPCC=0
- +4 SET ACDFHCP=1
- SET ACDMODE="A"
- SET ACDQ=0
- +5 DO MAIN
- +6 QUIT
- +7 ;
- MAIN ;
- +1 FOR
- DO PATLOOP
- IF ACDQ
- QUIT
- +2 DO EOJ
- +3 QUIT
- +4 ;
- PATLOOP ; DISPLAY PATIENTS UNTIL DONE
- +1 DO GETPAT
- +2 IF ACDQ
- QUIT
- +3 ; gather all visits for patient
- DO GETVSITS^ACDDEU
- +4 IF ACDQ
- QUIT
- +5 ; select visit to display
- DO SELECT
- +6 IF ACDQ
- QUIT
- +7 ; print hardcopy or gen pcc link
- DO GENOUTP
- +8 QUIT
- +9 ;
- GETPAT ; GET PATIENT
- +1 SET ACDQ=1
- +2 SET AUPNLK("ALL")=1
- +3 SET DIC="^AUPNPAT("
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $D(^ACDVIS(""D"",Y))"
- DO DIC^ACDFMC
- +4 KILL AUPNLK("ALL")
- +5 IF Y<0
- QUIT
- +6 SET ACDDFNP=+Y
- SET ACDDFN=$PIECE(^DPT(ACDDFNP,0),U)
- +7 SET ACDQ=0
- +8 QUIT
- +9 ;
- SELECT ; SELECT A CDMIS VISIT
- +1 SET ACDQ=1
- +2 WRITE !
- +3 SET ACDVIEN=0
- +4 KILL ACDVLST
- +5 IF $ORDER(^TMP("ACD",$JOB,"VISITS",0))=""
- WRITE !,"----------",!,"No CDMIS visits!",!,"----------",!
- QUIT
- +6 SET ACDDTLOW=0
- SET ACDDTHI=9999999
- +7 IF ACDVCNT>20
- DO GETDTRNG
- IF ACDQ
- QUIT
- WRITE !
- +8 SET ACDQ=1
- +9 WRITE !
- +10 SET ACDLC=0
- +11 SET ACDX=ACDDTLOW
- IF ACDX>0
- SET ACDX=ACDX-1
- +12 FOR
- SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
- IF ACDX=""
- QUIT
- IF ACDX'<ACDDTLOW
- IF ACDX'>ACDDTHI
- SET ACDY=0
- FOR
- SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
- IF 'ACDY
- QUIT
- Begin DoDot:1
- +13 SET ACDQ=0
- +14 SET ACDLC=ACDLC+1
- +15 SET ACDVLST(ACDLC)=ACDY
- +16 SET DIC="9002172.1"
- SET DA=ACDY
- SET DR=".01;1;3;5"
- SET DIQ="ACDPDD("
- +17 DO DIQ1^ACDFMC
- +18 WRITE ACDLC,?5,ACDPDD(9002172.1,ACDY,.01),?18," - ",ACDPDD(9002172.1,ACDY,1),"/",ACDPDD(9002172.1,ACDY,5)," ",ACDPDD(9002172.1,ACDY,3),!
- +19 KILL ACDPDD
- +20 IF '(ACDLC#20)
- DO PAUSE^ACDDEU
- IF $DATA(DIRUT)
- SET ACDQ=1
- +21 QUIT
- End DoDot:1
- IF ACDQ
- QUIT
- +22 SET ACDQ=1
- +23 IF 'ACDLC
- WRITE !,"No visits in date range",!
- QUIT
- +24 SET DIR(0)="NO^1:"_ACDLC
- SET DIR("A")="Select one of the listed visits"
- KILL DA
- DO ^DIR
- KILL DIR
- +25 IF Y
- SET ACDVIEN=ACDVLST(Y)
- +26 KILL ACDLC,ACDVLST
- +27 IF 'ACDVIEN
- QUIT
- +28 SET ACDQ=0
- +29 QUIT
- +30 ;
- GETDTRNG ; GET DATE RANGE FOR VISIT
- +1 SET ACDQ=1
- +2 SET ACDDTLOW=$ORDER(^TMP("ACD",$JOB,"VISITS",0))
- SET ACDDTHI=$ORDER(^TMP("ACD",$JOB,"VISITS","Z"),-1)
- +3 WRITE !,"Patient has ",ACDVCNT," visits between ",$$FMTE^XLFDT(ACDDTLOW,"1")," and ",$$FMTE^XLFDT(ACDDTHI,"1"),".",!,"Enter date range of desired visit.",!
- +4 SET DIR(0)="DO^::E"
- SET DIR("A")="Enter beginning date"
- KILL DA
- DO ^DIR
- KILL DIR
- +5 IF 'Y
- QUIT
- +6 SET ACDDTLOW=Y
- +7 SET DIR(0)="D^"_Y_"::E"
- SET DIR("A")="Enter ending date"
- SET DIR("B")=X
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF $DATA(DIRUT)
- QUIT
- +9 SET ACDDTHI=Y
- +10 SET ACDQ=0
- +11 QUIT
- +12 ;
- GENOUTP ; EP - PRINT HARDCOPY OR GENERATE PCC LINK FOR CDMIS VISIT
- +1 IF ACDFPCC
- IF $ORDER(^ACDVIS(ACDVIEN,21,0))
- WRITE !!,"This visit already has an associated PCC visit!",!
- QUIT
- +2 SET X=$PIECE(^ACDVIS(ACDVIEN,0),U,4)
- +3 IF X'="IN"
- IF X'="RE"
- IF X'="FU"
- IF X'="IR"
- IF X'="OT"
- IF X'="TD"
- IF X'="CS"
- WRITE !,"INVALID TYPE CONTACT",!
- +4 IF '$TEST
- SET ACDCONT=X
- DO @("SET"_ACDCONT)
- +5 IF 'ACDQ
- SET ACDPCCLS=1
- DO VISIT^ACDPCCL
- KILL ACDPCCLS
- +6 QUIT
- +7 ;
- SETIN ; INITIAL
- +1 DO SETIIF
- +2 QUIT
- +3 ;
- SETRE ; REOPEN
- +1 DO SETIIF
- +2 QUIT
- +3 ;
- SETFU ; FOLLOWUP
- +1 DO SETIIF
- +2 QUIT
- +3 ;
- SETIIF ; HARDCOPY FROM IIF ENTRY
- +1 SET ACDQ=1
- +2 KILL ACDPCCL
- +3 SET Y=$ORDER(^ACDIIF("C",ACDVIEN,0))
- +4 IF 'Y
- QUIT
- +5 SET ACDPCCL(ACDDFNP,ACDVIEN,"IIF",Y)=""
- +6 SET ACDPCCL(ACDDFNP,ACDVIEN)=""
- +7 SET ACDQ=0
- +8 QUIT
- +9 ;
- SETTD ; HARDCOPY FROM TDC ENTRY
- +1 SET ACDQ=1
- +2 KILL ACDPCCL
- +3 SET Y=$ORDER(^ACDTDC("C",ACDVIEN,0))
- +4 IF 'Y
- QUIT
- +5 SET ACDPCCL(ACDDFNP,ACDVIEN,"TDC",Y)=""
- +6 SET ACDPCCL(ACDDFNP,ACDVIEN)=""
- +7 SET ACDQ=0
- +8 QUIT
- +9 ;
- SETCS ; HARDCOPY OR PCC LINK FROM CLIENT SERVICES
- +1 SET ACDY=0
- +2 FOR
- SET ACDY=$ORDER(^ACDCS("C",ACDVIEN,ACDY))
- IF 'ACDY
- QUIT
- Begin DoDot:1
- +3 SET ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDY)=""
- +4 QUIT
- End DoDot:1
- +5 QUIT
- +6 ;
- EOJ ;
- +1 KILL ACDEV,ACDPCCL
- +2 DO ^ACDKILL
- +3 QUIT
