- ACDPCS1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT CS BY PROVIDER FOR 1 MONTH;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;
- ; This routine displays a patient's CDMIS client services by provider for one month.
- ;
- START ;
- F D PATLOOP Q:ACDQ
- D EOJ
- Q
- ;
- PATLOOP ; DISPLAY PATIENTS UNTIL DONE
- D GETPAT
- Q:ACDQ
- S ACDTCTG="CS"
- D GETVSITS^ACDDEU
- K ACDTCTG
- 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^ACDCSH1M",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
- S ACDQ=0
- D DEV^ACDDEU Q:ACDQ
- 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
- I $D(ZTQUEUED) D EOJ S ZTREQ="@"
- U 0
- Q
- ;
- DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
- I $E(IOST,1,2)="C-" W @IOF
- D CONF^ACDDEU W !
- W "CDMIS CLIENT SERVICE history for client ",ACDDFN,!!
- W "----------",!
- S ACDX=ACDSTART,ACDQ=0
- F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:$E(ACDX,1,5)'=ACDMONTH D Q:ACDQ
- . S ACDY=0
- . F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D Q:ACDQ
- .. Q:$P(^ACDVIS(ACDY,0),U,4)'="CS"
- .. S ACDVIEN=ACDY
- .. D DSPV^ACDDEU
- .. D DSPCSH
- .. Q
- . Q
- W "----------",!
- Q
- ;
- DSPCSH ; DISPLAY CDMIS CLIENT SERVICE HISTORY FOR ONE CS VISIT
- K ^TMP("ACD",$J,"CS")
- S YY=0
- F S YY=$O(^ACDCS("C",ACDVIEN,YY)) Q:'YY S X=^ACDCS(YY,0) D
- . S Z=0
- . F S Z=$O(^ACDCS(YY,1,Z)) Q:'Z D
- .. S ACDPRV=$P(^ACDCS(YY,1,Z,0),U)
- .. S ^TMP("ACD",$J,"CS",ACDPRV,$P(X,U),YY)=$P(X,U,2)
- .. Q
- . Q
- S ACDPRV=0
- F S ACDPRV=$O(^TMP("ACD",$J,"CS",ACDPRV)) Q:'ACDPRV D Q:ACDQ
- .; D PFTV^XBPFTV(6,ACDPRV,.X)
- . S X=$P(^VA(200,ACDPRV,0),U)
- . W ?5,X,!
- . S YY=0
- . F S YY=$O(^TMP("ACD",$J,"CS",ACDPRV,YY)) Q:'YY S Z=0 F S Z=$O(^TMP("ACD",$J,"CS",ACDPRV,YY,Z)) Q:'Z D Q:ACDQ
- .. S X=^TMP("ACD",$J,"CS",ACDPRV,YY,Z)
- .. D PFTV^XBPFTV(9002170.6,X,.W)
- .. D F Q:ACDQ
- .. W ?15,YY,?19,W,?55,$J(+$P(^ACDCS(Z,0),U,4),5,2)_" h",!
- .. Q
- . Q
- K ^TMP("ACD",$J,"CS")
- Q
- ;
- F ;Form feed
- I $Y+4>IOSL D
- . I '$D(ZTQUEUED),'$D(ACDSLAVE),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1
- . W @IOF
- . Q
- Q
- ;
- GETVSITS ; EP - GET CDMIS VISITS FOR THIS CLIENT
- ;
- 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
- K ^TMP("ACD",$J)
- D ^ACDKILL
- Q
- ACDPCS1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT CS BY PROVIDER FOR 1 MONTH;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;
- +3 ; This routine displays a patient's CDMIS client services by provider 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 SET ACDTCTG="CS"
- +4 DO GETVSITS^ACDDEU
- +5 KILL ACDTCTG
- +6 IF ACDQ
- QUIT
- +7 IF '$DATA(^TMP("ACD",$JOB,"VISITS"))
- WRITE !!,"No CDMIS VISIT history for patient ",ACDDFN,!
- QUIT
- +8 ; display visit history
- DO DSPHIST
- +9 DO GETMONTH
- +10 IF ACDQ
- QUIT
- +11 SET ACDSTART=$$FMADD^XLFDT(ACDMONTH_"01",-1)
- +12 SET X=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDSTART))
- +13 IF $EXTRACT(X,1,5)'=ACDMONTH
- WRITE !!,"No CDMIS VISITs during selected month for patient ",ACDDFN,!
- QUIT
- +14 IF $DATA(IO("Q"))
- Begin DoDot:1
- +15 SET ZTRTN="DISPLAY^ACDCSH1M"
- SET ZTDESC="CDMIS VISITS ONE MONTH"
- SET ZTDTH=$HOROLOG
- SET ZTSAVE("ACD*")=""
- SET ZTSAVE("^TMP(""ACD"",$J,""VISITS"",")=""
- +16 DO ^%ZTLOAD
- +17 QUIT
- End DoDot:1
- QUIT
- +18 DO DISPLAY
- +19 IF '$DATA(ACDSLAVE)
- IF $EXTRACT(IOST,1,2)'="P-"
- DO PAUSE^ACDDEU
- +20 SET ACDQ=0
- +21 DO DEV^ACDDEU
- IF ACDQ
- QUIT
- +22 IF $DATA(ACDSLAVE)!(IO'=IO(0))
- DO DISPLAY
- +23 KILL ACDSLAVE
- SET IO=IO(0)
- +24 QUIT
- +25 ;
- 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 IF $DATA(ZTQUEUED)
- DO EOJ
- SET ZTREQ="@"
- +7 USE 0
- +8 QUIT
- +9 ;
- DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
- +1 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +2 DO CONF^ACDDEU
- WRITE !
- +3 WRITE "CDMIS CLIENT SERVICE history for client ",ACDDFN,!!
- +4 WRITE "----------",!
- +5 SET ACDX=ACDSTART
- SET ACDQ=0
- +6 FOR
- SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
- IF $EXTRACT(ACDX,1,5)'=ACDMONTH
- QUIT
- Begin DoDot:1
- +7 SET ACDY=0
- +8 FOR
- SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
- IF 'ACDY
- QUIT
- Begin DoDot:2
- +9 IF $PIECE(^ACDVIS(ACDY,0),U,4)'="CS"
- QUIT
- +10 SET ACDVIEN=ACDY
- +11 DO DSPV^ACDDEU
- +12 DO DSPCSH
- +13 QUIT
- End DoDot:2
- IF ACDQ
- QUIT
- +14 QUIT
- End DoDot:1
- IF ACDQ
- QUIT
- +15 WRITE "----------",!
- +16 QUIT
- +17 ;
- DSPCSH ; DISPLAY CDMIS CLIENT SERVICE HISTORY FOR ONE CS VISIT
- +1 KILL ^TMP("ACD",$JOB,"CS")
- +2 SET YY=0
- +3 FOR
- SET YY=$ORDER(^ACDCS("C",ACDVIEN,YY))
- IF 'YY
- QUIT
- SET X=^ACDCS(YY,0)
- Begin DoDot:1
- +4 SET Z=0
- +5 FOR
- SET Z=$ORDER(^ACDCS(YY,1,Z))
- IF 'Z
- QUIT
- Begin DoDot:2
- +6 SET ACDPRV=$PIECE(^ACDCS(YY,1,Z,0),U)
- +7 SET ^TMP("ACD",$JOB,"CS",ACDPRV,$PIECE(X,U),YY)=$PIECE(X,U,2)
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 SET ACDPRV=0
- +11 FOR
- SET ACDPRV=$ORDER(^TMP("ACD",$JOB,"CS",ACDPRV))
- IF 'ACDPRV
- QUIT
- Begin DoDot:1
- +12 ; D PFTV^XBPFTV(6,ACDPRV,.X)
- +13 SET X=$PIECE(^VA(200,ACDPRV,0),U)
- +14 WRITE ?5,X,!
- +15 SET YY=0
- +16 FOR
- SET YY=$ORDER(^TMP("ACD",$JOB,"CS",ACDPRV,YY))
- IF 'YY
- QUIT
- SET Z=0
- FOR
- SET Z=$ORDER(^TMP("ACD",$JOB,"CS",ACDPRV,YY,Z))
- IF 'Z
- QUIT
- Begin DoDot:2
- +17 SET X=^TMP("ACD",$JOB,"CS",ACDPRV,YY,Z)
- +18 DO PFTV^XBPFTV(9002170.6,X,.W)
- +19 DO F
- IF ACDQ
- QUIT
- +20 WRITE ?15,YY,?19,W,?55,$JUSTIFY(+$PIECE(^ACDCS(Z,0),U,4),5,2)_" h",!
- +21 QUIT
- End DoDot:2
- IF ACDQ
- QUIT
- +22 QUIT
- End DoDot:1
- IF ACDQ
- QUIT
- +23 KILL ^TMP("ACD",$JOB,"CS")
- +24 QUIT
- +25 ;
- F ;Form feed
- +1 IF $Y+4>IOSL
- Begin DoDot:1
- +2 IF '$DATA(ZTQUEUED)
- IF '$DATA(ACDSLAVE)
- IF $EXTRACT(IOST,1,2)'="P-"
- DO PAUSE^ACDDEU
- IF $DATA(DIRUT)
- SET ACDQ=1
- +3 WRITE @IOF
- +4 QUIT
- End DoDot:1
- +5 QUIT
- +6 ;
- GETVSITS ; EP - GET CDMIS VISITS FOR THIS CLIENT
- +1 ;
- 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 KILL ^TMP("ACD",$JOB)
- +3 DO ^ACDKILL
- +4 QUIT
