PSOSUTL1 ;BIRM/WPB-Rx Suspense File Cross Reference Utility ; 12/7/95
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
SDIVAS S:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)=""
I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",9))&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8)) D
.K ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)
.S ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)=""
Q
KDIVAS K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)
K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",8))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),X,$P(^PS(52.5,DA,0),"^",11),DA)
Q
SPDTAS S:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",9))&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6)) D
.K ^PS(52.5,"AS",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
.S ^PS(52.5,"APR",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
Q
KPDTAS K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
K:$P($G(^PS(52.5,DA,0)),"^",9)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",X,$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
Q
SPBYAS S:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",8))&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6)) D
.K ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
.S ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)=""
Q
KPBYAS K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",11))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),X,$P(^PS(52.5,DA,0),"^",6),$P(^PS(52.5,DA,0),"^",11),DA)
Q
SSEQAS S:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,"P")),"^"))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)=""
I $P(^PS(52.5,DA,0),"^",7)="P"&($P($G(^PS(52.5,DA,0)),"^",8))&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6)) D
.K ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)
.S ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)=""
Q
KSEQAS K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="") ^PS(52.5,"AS",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)
K:$P($G(^PS(52.5,DA,0)),"^",8)&($P($G(^(0)),"^",9))&($P($G(^(0)),"^",6))&($P($G(^PS(52.5,DA,0)),"^",7)="P") ^PS(52.5,"APR",$P(^PS(52.5,DA,0),"^",8),$P(^PS(52.5,DA,0),"^",9),$P(^PS(52.5,DA,0),"^",6),X,DA)
Q
SADL I $P($G(^PS(52.5,DA,0)),"^",8),$G(^PS(52.5,DA,"P")) S ^PS(52.5,"ADL",$E($P(^PS(52.5,DA,0),"^",8),1,7),DA)=""
Q
KADL I $P($G(^PS(52.5,DA,0)),"^",8),$G(^PS(52.5,DA,"P")) K ^PS(52.5,"ADL",$E($P(^PS(52.5,DA,0),"^",8),1,7),DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSUTL1 4291 printed Dec 13, 2024@02:35:39 Page 2
PSOSUTL1 ;BIRM/WPB-Rx Suspense File Cross Reference Utility ; 12/7/95
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
SDIVAS if $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
SET ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
+1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",9))&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))
Begin DoDot:1
+2 KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)
+3 SET ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
End DoDot:1
+4 QUIT
KDIVAS if $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)
+1 if $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",8))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
KILL ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),X,$PIECE(^PS(52.5,DA,0),"^",11),DA)
+2 QUIT
SPDTAS if $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
SET ^PS(52.5,"AS",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
+1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",9))&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))
Begin DoDot:1
+2 KILL ^PS(52.5,"AS",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
+3 SET ^PS(52.5,"APR",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
End DoDot:1
+4 QUIT
KPDTAS if $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
KILL ^PS(52.5,"AS",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
+1 if $PIECE($GET(^PS(52.5,DA,0)),"^",9)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
KILL ^PS(52.5,"APR",X,$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
+2 QUIT
SPBYAS if $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
SET ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
+1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",8))&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))
Begin DoDot:1
+2 KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
+3 SET ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)=""
End DoDot:1
+4 QUIT
KPBYAS if $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
+1 if $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",11))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
KILL ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),X,$PIECE(^PS(52.5,DA,0),"^",6),$PIECE(^PS(52.5,DA,0),"^",11),DA)
+2 QUIT
SSEQAS if $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,"P")),"^"))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
SET ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)=""
+1 IF $PIECE(^PS(52.5,DA,0),"^",7)="P"&($PIECE($GET(^PS(52.5,DA,0)),"^",8))&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))
Begin DoDot:1
+2 KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)
+3 SET ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)=""
End DoDot:1
+4 QUIT
KSEQAS if $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="")
KILL ^PS(52.5,"AS",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)
+1 if $PIECE($GET(^PS(52.5,DA,0)),"^",8)&($PIECE($GET(^(0)),"^",9))&($PIECE($GET(^(0)),"^",6))&($PIECE($GET(^PS(52.5,DA,0)),"^",7)="P")
KILL ^PS(52.5,"APR",$PIECE(^PS(52.5,DA,0),"^",8),$PIECE(^PS(52.5,DA,0),"^",9),$PIECE(^PS(52.5,DA,0),"^",6),X,DA)
+2 QUIT
SADL IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)
IF $GET(^PS(52.5,DA,"P"))
SET ^PS(52.5,"ADL",$EXTRACT($PIECE(^PS(52.5,DA,0),"^",8),1,7),DA)=""
+1 QUIT
KADL IF $PIECE($GET(^PS(52.5,DA,0)),"^",8)
IF $GET(^PS(52.5,DA,"P"))
KILL ^PS(52.5,"ADL",$EXTRACT($PIECE(^PS(52.5,DA,0),"^",8),1,7),DA)
+1 QUIT
