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