- PSDCORP3 ;BIR/JPW-CS Correction Log Deleted Green Sheets ; 2 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;
- K ^TMP("PSDCOR3",$J)
- F PSD=PSDSD:0 S PSD=$O(^PSD(58.87,"AC",TYPE,PSDS,PSD)) Q:'PSD!(PSD>PSDED) F PSDA=0:0 S PSDA=$O(^PSD(58.87,"AC",TYPE,PSDS,PSD,PSDA)) Q:'PSDA I $D(^PSD(58.87,PSDA,0)) D
- .S NODE=^PSD(58.87,PSDA,0),PSDPN=$S($P(NODE,"^",4)]"":$P(NODE,"^",4),1:"UNKNOWN")
- .S DRUG=+$P(NODE,"^",5),DRUGN=$S($P($G(^PSDRUG(DRUG,0)),"^")]"":$P(^(0),"^"),1:"DRUG NAME MISSING")
- .S CURR=+$P(NODE,"^",15),PREV=+$P(NODE,"^",14),CURR=$P($G(^PSD(58.83,CURR,0)),"^"),PREV=$P($G(^PSD(58.83,PREV,0)),"^")
- .S NAOU=+$P(NODE,"^",6),NAOUN=$S($P($G(^PSD(58.8,NAOU,0)),"^")]"":$P(^(0),"^"),1:"NAOU NAME MISSING")
- .S TECH=+$P(NODE,"^",10),TECHN=$S($P($G(^VA(200,TECH,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
- .S PHARM=+$P(NODE,"^",3),PHARMN=$S($P($G(^VA(200,PHARM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN") I PHARMN'="UNKNOWN" S PHARMN=$P(PHARMN,",")_","_$E($P(PHARMN,",",2))
- .S Y=PSD X ^DD("DD") S PSDT=Y
- .S ^TMP("PSDCOR3",$J,NAOUN,PSDPN,PSDA)=DRUGN_"^"_PSDT_"^"_PHARMN_"^"_TECHN_"^"_CURR_"^"_PREV
- PRINT ;prints log
- K LN S (PG,PSDOUT)=0,$P(LN,"-",132)="" D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
- I '$D(^TMP("PSDCOR3",$J)) D HDR W !!,?20,"** NO GREEN SHEET DELETIONS REPORTED FROM ",$P(PSDATE,"^")," TO ",$P(PSDATE,"^",2)," **",!! G DONE
- D HDR S PSD="" F S PSD=$O(^TMP("PSDCOR3",$J,PSD)) Q:PSD=""!(PSDOUT) W !,?5,"=> ",PSD,! D
- .S NUM="" F S NUM=$O(^TMP("PSDCOR3",$J,PSD,NUM)) Q:NUM=""!(PSDOUT) F JJ=0:0 S JJ=$O(^TMP("PSDCOR3",$J,PSD,NUM,JJ)) Q:'JJ!(PSDOUT) D
- ..S NODE=^TMP("PSDCOR3",$J,PSD,NUM,JJ)
- ..I $Y+4>IOSL D HDR Q:PSDOUT W !,?5,"=> ",PSD,!!
- ..W NUM,?12,$P(NODE,"^"),?54,$P(NODE,"^",2),?76,$P(NODE,"^",3),?100,$P(NODE,"^",4),!,?15,"*",CURR,?65,"*",PREV,!
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
- END K %,%DT,%H,%I,C,CURR,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DRUG,DRUGN,DTOUT,DUOUT,IO("Q"),JJ,LN
- K NAOU,NAOUN,NODE,NUM,PHARM,PHARMN,PG,POP,PREV,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDPN,PSDOUT,PSDOUT,PSDS,PSDSD,PSDSN,PSDT,RPDT,TECH,TECHN,TYPE,X,Y
- K ^TMP("PSDCOR3",$J),ZTDESC,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- HDR ;header for log
- I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- S PG=PG+1 W:$Y @IOF W !,?25,"CS CORRECTION LOG - COMPLETED STATUS CHANGES",?115,"Page: ",PG,!,?25,"Report Range ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!,?25,"Report Printed: ",RPDT,!
- W !!,?5,"=> NAOU",!,?57,"DATE",?74,"CORRECTED BY"
- W !,"DISP #",?12,"DRUG",?54,"CORRECTED",?75,"PHARMACIST",?100,"ENTERED BY PHARMACIST",!,?15,"*CURRENT STATUS",?65,"*PREVIOUS STATUS",!,LN,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDCORP3 2785 printed Feb 18, 2025@23:11:44 Page 2
- PSDCORP3 ;BIR/JPW-CS Correction Log Deleted Green Sheets ; 2 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;
- +1 KILL ^TMP("PSDCOR3",$JOB)
- +2 FOR PSD=PSDSD:0
- SET PSD=$ORDER(^PSD(58.87,"AC",TYPE,PSDS,PSD))
- if 'PSD!(PSD>PSDED)
- QUIT
- FOR PSDA=0:0
- SET PSDA=$ORDER(^PSD(58.87,"AC",TYPE,PSDS,PSD,PSDA))
- if 'PSDA
- QUIT
- IF $DATA(^PSD(58.87,PSDA,0))
- Begin DoDot:1
- +3 SET NODE=^PSD(58.87,PSDA,0)
- SET PSDPN=$SELECT($PIECE(NODE,"^",4)]"":$PIECE(NODE,"^",4),1:"UNKNOWN")
- +4 SET DRUG=+$PIECE(NODE,"^",5)
- SET DRUGN=$SELECT($PIECE($GET(^PSDRUG(DRUG,0)),"^")]"":$PIECE(^(0),"^"),1:"DRUG NAME MISSING")
- +5 SET CURR=+$PIECE(NODE,"^",15)
- SET PREV=+$PIECE(NODE,"^",14)
- SET CURR=$PIECE($GET(^PSD(58.83,CURR,0)),"^")
- SET PREV=$PIECE($GET(^PSD(58.83,PREV,0)),"^")
- +6 SET NAOU=+$PIECE(NODE,"^",6)
- SET NAOUN=$SELECT($PIECE($GET(^PSD(58.8,NAOU,0)),"^")]"":$PIECE(^(0),"^"),1:"NAOU NAME MISSING")
- +7 SET TECH=+$PIECE(NODE,"^",10)
- SET TECHN=$SELECT($PIECE($GET(^VA(200,TECH,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
- +8 SET PHARM=+$PIECE(NODE,"^",3)
- SET PHARMN=$SELECT($PIECE($GET(^VA(200,PHARM,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
- IF PHARMN'="UNKNOWN"
- SET PHARMN=$PIECE(PHARMN,",")_","_$EXTRACT($PIECE(PHARMN,",",2))
- +9 SET Y=PSD
- XECUTE ^DD("DD")
- SET PSDT=Y
- +10 SET ^TMP("PSDCOR3",$JOB,NAOUN,PSDPN,PSDA)=DRUGN_"^"_PSDT_"^"_PHARMN_"^"_TECHN_"^"_CURR_"^"_PREV
- End DoDot:1
- PRINT ;prints log
- +1 KILL LN
- SET (PG,PSDOUT)=0
- SET $PIECE(LN,"-",132)=""
- DO NOW^%DTC
- SET Y=+$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- SET RPDT=Y
- +2 IF '$DATA(^TMP("PSDCOR3",$JOB))
- DO HDR
- WRITE !!,?20,"** NO GREEN SHEET DELETIONS REPORTED FROM ",$PIECE(PSDATE,"^")," TO ",$PIECE(PSDATE,"^",2)," **",!!
- GOTO DONE
- +3 DO HDR
- SET PSD=""
- FOR
- SET PSD=$ORDER(^TMP("PSDCOR3",$JOB,PSD))
- if PSD=""!(PSDOUT)
- QUIT
- WRITE !,?5,"=> ",PSD,!
- Begin DoDot:1
- +4 SET NUM=""
- FOR
- SET NUM=$ORDER(^TMP("PSDCOR3",$JOB,PSD,NUM))
- if NUM=""!(PSDOUT)
- QUIT
- FOR JJ=0:0
- SET JJ=$ORDER(^TMP("PSDCOR3",$JOB,PSD,NUM,JJ))
- if 'JJ!(PSDOUT)
- QUIT
- Begin DoDot:2
- +5 SET NODE=^TMP("PSDCOR3",$JOB,PSD,NUM,JJ)
- +6 IF $Y+4>IOSL
- DO HDR
- if PSDOUT
- QUIT
- WRITE !,?5,"=> ",PSD,!!
- +7 WRITE NUM,?12,$PIECE(NODE,"^"),?54,$PIECE(NODE,"^",2),?76,$PIECE(NODE,"^",3),?100,$PIECE(NODE,"^",4),!,?15,"*",CURR,?65,"*",PREV,!
- End DoDot:2
- End DoDot:1
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF 'PSDOUT
- WRITE !
- KILL DIR,DIRUT
- SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
- DO ^DIR
- KILL DIR
- END KILL %,%DT,%H,%I,C,CURR,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DRUG,DRUGN,DTOUT,DUOUT,IO("Q"),JJ,LN
- +1 KILL NAOU,NAOUN,NODE,NUM,PHARM,PHARMN,PG,POP,PREV,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDPN,PSDOUT,PSDOUT,PSDS,PSDSD,PSDSN,PSDT,RPDT,TECH,TECHN,TYPE,X,Y
- +2 KILL ^TMP("PSDCOR3",$JOB),ZTDESC,ZTIO,ZTRTN,ZTSAVE
- DO ^%ZISC
- +3 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 QUIT
- HDR ;header for log
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PG
- WRITE !
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 SET PG=PG+1
- if $Y
- WRITE @IOF
- WRITE !,?25,"CS CORRECTION LOG - COMPLETED STATUS CHANGES",?115,"Page: ",PG,!,?25,"Report Range ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!,?25,"Report Printed: ",RPDT,!
- +3 WRITE !!,?5,"=> NAOU",!,?57,"DATE",?74,"CORRECTED BY"
- +4 WRITE !,"DISP #",?12,"DRUG",?54,"CORRECTED",?75,"PHARMACIST",?100,"ENTERED BY PHARMACIST",!,?15,"*CURRENT STATUS",?65,"*PREVIOUS STATUS",!,LN,!
- +5 QUIT