- PSOORAL2 ;BHAM-ISC/SAB -build listman activity logs con't ;04/28/95
- ;;7.0;OUTPATIENT PHARMACY;**258,260**;DEC 1997;Build 84
- RF ;refill log
- S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Refill Log:"
- S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Log Date Refill Date Qty Routing Lot # Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
- S (RF,PL)=0 F RF=0:0 S RF=$O(^PSRX(DA,1,RF)) Q:'RF S PL=PL+1
- I 'PL S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Refills For this Prescription" Q
- F N=0:0 S N=$O(^PSRX(DA,1,N)) Q:'N S P1=^(N,0) D
- .S DTT=$P(P1,"^",8)\1 D DAT S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" "
- .S DTT=$P(P1,"^"),$P(RN," ",10)=" " D DAT
- .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_" "_$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15)_" "_$S($P(P1,"^",2)="M":"Mail",1:"Window")_" "_$P(P1,"^",6)_$E(RN,$L($P(P1,"^",6))+1,12)
- .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_$E($S($D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16)
- .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"Unknown"),IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_$E(" ",$L(PSDIV)+1,8)_" "
- .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"Dispensed: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")_" "
- .S RTS=$S($P(P1,"^",16):" Returned to Stock: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" Released: "_$S($$RXRLDT^PSOBPSUT(DA,N):$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(DA,N)\1,2),1:""))
- .I $$STATUS^PSOBPSUT(DA,N)'="",$$RXRLDT^PSOBPSUT(DA,N) S RTS=RTS_" NDC: "_$$GETNDC^PSONDCUT(DA,N)
- .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RTS S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Remarks: "_$P(P1,"^",3)
- K RTS Q
- PAR ;partial log
- S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Partial Fills:"
- S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Log Date Date Qty Routing Lot # Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="
- I '$O(^PSRX(DA,"P",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Partials for this Prescription" Q
- S N=0 F S N=$O(^PSRX(DA,"P",N)) Q:'N S P1=^(N,0),DTT=$P(P1,"^",8)\1 D DAT D
- .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" ",QTY=$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15)
- .S DTT=$P(P1,"^") D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_" "_QTY_" "
- .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"UNKNOWN"),PSDIV=PSDIV_$E(" ",$L(PSDIV)+1,8)
- .S MW=$S($P(P1,"^",2)="M":"Mail",1:"Window"),MW=MW_$E(" ",$L(MW)+1,10)
- .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_MW_" "_$P(P1,"^",6)_$E(" ",$L($P(P1,"^",6))+1,10)_$E($S($D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16)
- .S RTS=$S($P(P1,"^",16):" RETURNED TO STOCK: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" RELEASED: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:""))
- .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_" "_RTS ;_" Entry By: "_$P(^VA(200,$P(P1,"^",7),0),"^")
- .S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" REMARKS: "_$P(P1,"^",3) K RTS
- Q
- HLD ;hold info
- S DTT=$P(^PSRX(DA,"H"),"^",3) D DAT S HLDR=$P(^DD(52,99,0),"^",3),HLDR=$S($P(^PSRX(DA,"H"),"^")'>8:$P(HLDR,";",$P(^PSRX(DA,"H"),"^")),1:$P(HLDR,";",9)),HLDR=$P(HLDR,":",2)
- S $P(RN," ",60)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Reason: "_HLDR_$E(RN,$L("Hold Reason: "_HLDR)+1,60)_"Hold Date: "_DAT S:$P(^PSRX(DA,"H"),"^",2)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Comments: "_$P(^PSRX(DA,"H"),"^",2)
- K RN,DAT,DTT,HLDR
- Q
- DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)
- Q
- PSOORAL2 ;BHAM-ISC/SAB -build listman activity logs con't ;04/28/95
- +1 ;;7.0;OUTPATIENT PHARMACY;**258,260**;DEC 1997;Build 84
- RF ;refill log
- +1 SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="Refill Log:"
- +2 SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="# Log Date Refill Date Qty Routing Lot # Pharmacist"
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
- +3 SET (RF,PL)=0
- FOR RF=0:0
- SET RF=$ORDER(^PSRX(DA,1,RF))
- IF 'RF
- QUIT
- SET PL=PL+1
- +4 IF 'PL
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Refills For this Prescription"
- QUIT
- +5 FOR N=0:0
- SET N=$ORDER(^PSRX(DA,1,N))
- IF 'N
- QUIT
- SET P1=^(N,0)
- Begin DoDot:1
- +6 SET DTT=$PIECE(P1,"^",8)\1
- DO DAT
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)=N_" "_DAT_" "
- +7 SET DTT=$PIECE(P1,"^")
- SET $PIECE(RN," ",10)=" "
- DO DAT
- +8 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_DAT_" "_$PIECE(P1,"^",4)_$EXTRACT(" ",$LENGTH($PIECE(P1,"^",4))+1,15)_" "_$SELECT($PIECE(P1,"^",2)="M":"Mail",1:"Window")_" "_$PIECE(P1,"^",6)_$EXTRACT(RN,...
- ... $LENGTH($PIECE(P1,"^",6))+1,12)
- +9 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(P1,"^",5),0)):$PIECE(^(0),"^"),1:""),1,16)
- +10 SET PSDIV=$SELECT($DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^",6),1:"Unknown")
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="Division: "_PSDIV_$EXTRACT(" ",$LENGTH(PSDIV)+1,8)_" "
- +11 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"Dispensed: "_$SELECT($PIECE(P1,"^",19):$EXTRACT($PIECE(P1,"^",19),4,5)_"/"_$EXTRACT($PIECE(P1,"^",19),6,7)_"/"_$EXTRACT($PIECE(P1,"^",19),2,3),1:"")_" "
- +12 SET RTS=$SELECT($PIECE(P1,"^",16):" Returned to Stock: "_$EXTRACT($PIECE(P1,"^",16),4,5)_"/"_$EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:" Released: "_...
- ... $SELECT($$RXRLDT^PSOBPSUT(DA,N):$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(DA,N)\1,2),1:""))
- +13 IF $$STATUS^PSOBPSUT(DA,N)'=""
- IF $$RXRLDT^PSOBPSUT(DA,N)
- SET RTS=RTS_" NDC: "_$$GETNDC^PSONDCUT(DA,N)
- +14 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RTS
- IF $PIECE(P1,"^",3)]""
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)=" Remarks: "_$PIECE(P1,"^",3)
- End DoDot:1
- +15 KILL RTS
- QUIT
- PAR ;partial log
- +1 SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="Partial Fills:"
- +2 SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="# Log Date Date Qty Routing Lot # Pharmacist"
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="
- +3 IF '$ORDER(^PSRX(DA,"P",0))
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Partials for this Prescription"
- QUIT
- +4 SET N=0
- FOR
- SET N=$ORDER(^PSRX(DA,"P",N))
- IF 'N
- QUIT
- SET P1=^(N,0)
- SET DTT=$PIECE(P1,"^",8)\1
- DO DAT
- Begin DoDot:1
- +5 SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)=N_" "_DAT_" "
- SET QTY=$PIECE(P1,"^",4)_$EXTRACT(" ",$LENGTH($PIECE(P1,"^",4))+1,15)
- +6 SET DTT=$PIECE(P1,"^")
- DO DAT
- SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_DAT_" "_QTY_" "
- +7 SET PSDIV=$SELECT($DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^",6),1:"UNKNOWN")
- SET PSDIV=PSDIV_$EXTRACT(" ",$LENGTH(PSDIV)+1,8)
- +8 SET MW=$SELECT($PIECE(P1,"^",2)="M":"Mail",1:"Window")
- SET MW=MW_$EXTRACT(" ",$LENGTH(MW)+1,10)
- +9 SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_MW_" "_$PIECE(P1,"^",6)_$EXTRACT(" ",$LENGTH($PIECE(P1,"^",6))+1,10)_$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(P1,"^",5),0)):$PIECE(^(0),"^"),1:""),1,16)
- +10 SET RTS=$SELECT($PIECE(P1,"^",16):" RETURNED TO STOCK: "_$EXTRACT(...
- ... $PIECE(P1,"^",16),4,5)_"/"_$EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:" RELEASED: "_$SELECT($PIECE(P1,"^",19):$EXTRACT($PIECE(P1,"^",19),4,5)_"/"_$EXTRACT($PIECE(P1,"^",19),6,7)_"/"_$EXTRACT($PIECE(P1,"^",
- 19),2,3),1:""))
- +11 ;_" Entry By: "_$P(^VA(200,$P(P1,"^",7),0),"^")
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="Division: "_PSDIV_" "_RTS
- +12 IF $PIECE(P1,"^",3)]""
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)=" REMARKS: "_$PIECE(P1,"^",3)
- KILL RTS
- End DoDot:1
- +13 QUIT
- HLD ;hold info
- +1 SET DTT=$PIECE(^PSRX(DA,"H"),"^",3)
- DO DAT
- SET HLDR=$PIECE(^DD(52,99,0),"^",3)
- SET HLDR=$SELECT($PIECE(^PSRX(DA,"H"),"^")'>8:$PIECE(HLDR,";",$PIECE(^PSRX(DA,"H"),"^")),1:$PIECE(HLDR,";",9))
- SET HLDR=$PIECE(HLDR,":",2)
- +2 SET $PIECE(RN," ",60)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="Hold Reason: "_HLDR_$EXTRACT(RN,$LENGTH("Hold Reason: "_HLDR)+1,60)_"Hold Date: "_DAT
- IF $PIECE(^PSRX(DA,"H"),"^",2)]""
- SET IEN=IEN+1
- SET ^TMP("PSOAL",$JOB,IEN,0)="Hold Comments: "_$PIECE(^PSRX(DA,"H"),"^",2)
- +3 KILL RN,DAT,DTT,HLDR
- +4 QUIT
- DAT SET DAT=""
- SET DTT=DTT\1
- IF DTT'?7N
- QUIT
- SET DAT=$EXTRACT(DTT,4,5)_"/"_$EXTRACT(DTT,6,7)_"/"_$EXTRACT(DTT,2,3)
- +1 QUIT
