- ACDPVH1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISITS FOR 1 MO;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;
- ; This routine displays a patient's CDMIS visits for one month.
- ;
- START ;
- F D PATLOOP Q:ACDQ
- D EOJ
- Q
- ;
- PATLOOP ; DISPLAY PATIENTS UNTIL DONE
- D GETPAT
- Q:ACDQ
- D GETVSITS^ACDDEU
- Q:ACDQ
- I '$D(^TMP("ACD",$J,"VISITS")) W !!,"No CDMIS VISIT history for patient ",ACDDFN,! Q
- D DSPHIST ; display visit history
- D GETMONTH
- Q:ACDQ
- S ACDSTART=$$FMADD^XLFDT(ACDMONTH_"01",-1)
- S X=$O(^TMP("ACD",$J,"VISITS",ACDSTART))
- I $E(X,1,5)'=ACDMONTH W !!,"No CDMIS VISITs during selected month for patient ",ACDDFN,! Q
- I $D(IO("Q")) D Q
- . S ZTRTN="DISPLAY^ACDPVH1M",ZTDESC="CDMIS VISITS ONE MONTH",ZTDTH=$H,ZTSAVE("ACD*")="",ZTSAVE("^TMP(""ACD"",$J,""VISITS"",")=""
- . D ^%ZTLOAD
- . Q
- D DISPLAY
- I '$D(ACDSLAVE),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU
- D DEV^ACDDEU Q:ACDQ ; select device
- I $D(ACDSLAVE)!(IO'=IO(0)) D DISPLAY
- K ACDSLAVE S IO=IO(0)
- Q
- ;
- DSPHIST ; DISPLAY VISIT HISTORY TO HELP USER SELECT
- NEW IOST
- S IOST="C-VT100"
- D DSPHIST^ACDDEU ; display visit history
- Q
- ;
- DISPLAY ; EP - FOR TASKMAN
- I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS
- U IO
- D DISPLAY2
- I $E(IOST,1,2)="P-" W @IOF
- I $D(ACDSLAVE) D ^%ZISC
- U 0
- I $D(ZTQUEUED) D EOJ S ZTREQ="@"
- Q
- ;
- DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
- D CONF^ACDDEU W !
- W "CDMIS VISIT history for client ",ACDDFN,!!
- W "----------",!
- S ACDX=ACDSTART
- F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:$E(ACDX,1,5)'=ACDMONTH S ACDY=0 F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D DSPV^ACDDEU I $P(^ACDVIS(ACDY,0),U,4)="CS" S ACDVIEN=ACDY D DSPCSH^ACDDEU
- W "----------",!
- 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
- ;
- GETMONTH ; GET MONTH
- S ACDQ=1
- S DIR(0)="DO^::E",DIR("A")="Enter month/year" K DA D ^DIR K DIR
- Q:$D(DIRUT)
- Q:Y=""
- S ACDMONTH=$E(Y,1,5)
- S ACDQ=0
- Q
- ;
- EOJ ;
- D ^%ZISC
- D ^ACDKILL
- Q
- ACDPVH1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISITS FOR 1 MO;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;
- +3 ; This routine displays a patient's CDMIS visits for one month.
- +4 ;
- START ;
- +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 DO GETVSITS^ACDDEU
- +4 IF ACDQ
- QUIT
- +5 IF '$DATA(^TMP("ACD",$JOB,"VISITS"))
- WRITE !!,"No CDMIS VISIT history for patient ",ACDDFN,!
- QUIT
- +6 ; display visit history
- DO DSPHIST
- +7 DO GETMONTH
- +8 IF ACDQ
- QUIT
- +9 SET ACDSTART=$$FMADD^XLFDT(ACDMONTH_"01",-1)
- +10 SET X=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDSTART))
- +11 IF $EXTRACT(X,1,5)'=ACDMONTH
- WRITE !!,"No CDMIS VISITs during selected month for patient ",ACDDFN,!
- QUIT
- +12 IF $DATA(IO("Q"))
- Begin DoDot:1
- +13 SET ZTRTN="DISPLAY^ACDPVH1M"
- SET ZTDESC="CDMIS VISITS ONE MONTH"
- SET ZTDTH=$HOROLOG
- SET ZTSAVE("ACD*")=""
- SET ZTSAVE("^TMP(""ACD"",$J,""VISITS"",")=""
- +14 DO ^%ZTLOAD
- +15 QUIT
- End DoDot:1
- QUIT
- +16 DO DISPLAY
- +17 IF '$DATA(ACDSLAVE)
- IF $EXTRACT(IOST,1,2)'="P-"
- DO PAUSE^ACDDEU
- +18 ; select device
- DO DEV^ACDDEU
- IF ACDQ
- QUIT
- +19 IF $DATA(ACDSLAVE)!(IO'=IO(0))
- DO DISPLAY
- +20 KILL ACDSLAVE
- SET IO=IO(0)
- +21 QUIT
- +22 ;
- DSPHIST ; DISPLAY VISIT HISTORY TO HELP USER SELECT
- +1 NEW IOST
- +2 SET IOST="C-VT100"
- +3 ; display visit history
- DO DSPHIST^ACDDEU
- +4 QUIT
- +5 ;
- DISPLAY ; EP - FOR TASKMAN
- +1 IF $DATA(ACDSLAVE)
- SET IOP=ACDSLAVE
- DO ^%ZIS
- +2 USE IO
- +3 DO DISPLAY2
- +4 IF $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF
- +5 IF $DATA(ACDSLAVE)
- DO ^%ZISC
- +6 USE 0
- +7 IF $DATA(ZTQUEUED)
- DO EOJ
- SET ZTREQ="@"
- +8 QUIT
- +9 ;
- DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
- +1 DO CONF^ACDDEU
- WRITE !
- +2 WRITE "CDMIS VISIT history for client ",ACDDFN,!!
- +3 WRITE "----------",!
- +4 SET ACDX=ACDSTART
- +5 FOR
- SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
- IF $EXTRACT(ACDX,1,5)'=ACDMONTH
- QUIT
- SET ACDY=0
- FOR
- SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
- IF 'ACDY
- QUIT
- DO DSPV^ACDDEU
- IF $PIECE(^ACDVIS(ACDY,0),U,4)="CS"
- SET ACDVIEN=ACDY
- DO DSPCSH^ACDDEU
- +6 WRITE "----------",!
- +7 QUIT
- +8 ;
- 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 ;
- GETMONTH ; GET MONTH
- +1 SET ACDQ=1
- +2 SET DIR(0)="DO^::E"
- SET DIR("A")="Enter month/year"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- QUIT
- +4 IF Y=""
- QUIT
- +5 SET ACDMONTH=$EXTRACT(Y,1,5)
- +6 SET ACDQ=0
- +7 QUIT
- +8 ;
- EOJ ;
- +1 DO ^%ZISC
- +2 DO ^ACDKILL
- +3 QUIT
