PSSXDIC ;;OIFIO BAY PINES/ELR - UPDATE DESCRIPTION OF FILE 54 - 3/2/2004
;;1.0; PHARMACY DATA MANAGEMENT;**84**;9/30/97
Q
START ;
I '$D(^PS(54,"B","NO TRANSFER")) D ZTQUE Q
S DA=$O(^PS(54,"B","NO TRANSFER",0))
I 'DA D ZTQUE Q
NEW PSSDA,PSSDIC,PSSI,PSSIENS,FDA
S PSSDIC(1)="CAUTION: Federal law prohibits the"
S PSSDIC(2)="transfer of this drug to any person"
S PSSDIC(3)="other than the patient for whom it"
S PSSDIC(4)="was prescribed."
LOCK +^PS(54,DA)
F PSSI=1:1:4 D
.S PSSDA=PSSI_","_DA
.D FDA
.D SET
LOCK -^PS(54,DA)
K DA,XMDUZ
Q
FDA ;
S PSSIENS=$$IENS^DILF(.PSSDA)
D FDA^DILF(54.1,PSSIENS,.01,"",PSSDIC(PSSI),"FDA(54)")
Q
SET D FILE^DIE("","FDA(54)","PSSIENS")
I $G(^TMP("DIERR",$J,1)) D ZTQUE
Q
BULL ; Bulletin for failed update
N PSSLN,PSSMSG S PSSLN=0
K ^TMP("PSSDIC",$J)
S XMSUB="DICITONARY MAINTENANCE (FILE 54) " K XMY
S XMTEXT="^TMP(""PSSDIC"",$J,"
S XMY($S(DUZ:DUZ,1:.5))=""
S XMDUZ=.5 D NOW^%DTC
S PSSMSG=" " D SETLN
S PSSMSG="The update of file RX CONSULT, NO TRANSFER description failed." D SETLN
S PSSMSG=" " D SETLN
D ^XMD
K ^TMP("PSSDIC",$J),XMY,XMTEXT,XMSUB
Q
SETLN ; Setting TMP global for bulletin
S PSSLN=PSSLN+1
S ^TMP("PSSDIC",$J,PSSLN)=PSSMSG
Q
ZTQUE ;
N ZTIO,ZTDTH,ZTDESC,ZTRTN,ZTSAVE
S ZTIO="",ZTDTH=$H,$P(ZTDTH,",",2)=$P(ZTDTH,",",2)+60,ZTDESC="PDM UPDATE ERROR"
S ZTRTN="BULL^PSSXDIC"
D ^%ZTLOAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSXDIC 1424 printed Nov 22, 2024@17:44:53 Page 2
PSSXDIC ;;OIFIO BAY PINES/ELR - UPDATE DESCRIPTION OF FILE 54 - 3/2/2004
+1 ;;1.0; PHARMACY DATA MANAGEMENT;**84**;9/30/97
+2 QUIT
START ;
+1 IF '$DATA(^PS(54,"B","NO TRANSFER"))
DO ZTQUE
QUIT
+2 SET DA=$ORDER(^PS(54,"B","NO TRANSFER",0))
+3 IF 'DA
DO ZTQUE
QUIT
+4 NEW PSSDA,PSSDIC,PSSI,PSSIENS,FDA
+5 SET PSSDIC(1)="CAUTION: Federal law prohibits the"
+6 SET PSSDIC(2)="transfer of this drug to any person"
+7 SET PSSDIC(3)="other than the patient for whom it"
+8 SET PSSDIC(4)="was prescribed."
+9 LOCK +^PS(54,DA)
+10 FOR PSSI=1:1:4
Begin DoDot:1
+11 SET PSSDA=PSSI_","_DA
+12 DO FDA
+13 DO SET
End DoDot:1
+14 LOCK -^PS(54,DA)
+15 KILL DA,XMDUZ
+16 QUIT
FDA ;
+1 SET PSSIENS=$$IENS^DILF(.PSSDA)
+2 DO FDA^DILF(54.1,PSSIENS,.01,"",PSSDIC(PSSI),"FDA(54)")
+3 QUIT
SET DO FILE^DIE("","FDA(54)","PSSIENS")
+1 IF $GET(^TMP("DIERR",$JOB,1))
DO ZTQUE
+2 QUIT
BULL ; Bulletin for failed update
+1 NEW PSSLN,PSSMSG
SET PSSLN=0
+2 KILL ^TMP("PSSDIC",$JOB)
+3 SET XMSUB="DICITONARY MAINTENANCE (FILE 54) "
KILL XMY
+4 SET XMTEXT="^TMP(""PSSDIC"",$J,"
+5 SET XMY($SELECT(DUZ:DUZ,1:.5))=""
+6 SET XMDUZ=.5
DO NOW^%DTC
+7 SET PSSMSG=" "
DO SETLN
+8 SET PSSMSG="The update of file RX CONSULT, NO TRANSFER description failed."
DO SETLN
+9 SET PSSMSG=" "
DO SETLN
+10 DO ^XMD
+11 KILL ^TMP("PSSDIC",$JOB),XMY,XMTEXT,XMSUB
+12 QUIT
SETLN ; Setting TMP global for bulletin
+1 SET PSSLN=PSSLN+1
+2 SET ^TMP("PSSDIC",$JOB,PSSLN)=PSSMSG
+3 QUIT
ZTQUE ;
+1 NEW ZTIO,ZTDTH,ZTDESC,ZTRTN,ZTSAVE
+2 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET $PIECE(ZTDTH,",",2)=$PIECE(ZTDTH,",",2)+60
SET ZTDESC="PDM UPDATE ERROR"
+3 SET ZTRTN="BULL^PSSXDIC"
+4 DO ^%ZTLOAD
+5 QUIT
