| 1 | PSSXDIC ;;OIFIO BAY PINES/ELR - UPDATE DESCRIPTION OF FILE 54 - 3/2/2004
|
|---|
| 2 | ;;1.0; PHARMACY DATA MANAGEMENT;**84**;9/30/97
|
|---|
| 3 | Q
|
|---|
| 4 | START ;
|
|---|
| 5 | I '$D(^PS(54,"B","NO TRANSFER")) D ZTQUE Q
|
|---|
| 6 | S DA=$O(^PS(54,"B","NO TRANSFER",0))
|
|---|
| 7 | I 'DA D ZTQUE Q
|
|---|
| 8 | NEW PSSDA,PSSDIC,PSSI,PSSIENS,FDA
|
|---|
| 9 | S PSSDIC(1)="CAUTION: Federal law prohibits the"
|
|---|
| 10 | S PSSDIC(2)="transfer of this drug to any person"
|
|---|
| 11 | S PSSDIC(3)="other than the patient for whom it"
|
|---|
| 12 | S PSSDIC(4)="was prescribed."
|
|---|
| 13 | LOCK +^PS(54,DA)
|
|---|
| 14 | F PSSI=1:1:4 D
|
|---|
| 15 | .S PSSDA=PSSI_","_DA
|
|---|
| 16 | .D FDA
|
|---|
| 17 | .D SET
|
|---|
| 18 | LOCK -^PS(54,DA)
|
|---|
| 19 | K DA,XMDUZ
|
|---|
| 20 | Q
|
|---|
| 21 | FDA ;
|
|---|
| 22 | S PSSIENS=$$IENS^DILF(.PSSDA)
|
|---|
| 23 | D FDA^DILF(54.1,PSSIENS,.01,"",PSSDIC(PSSI),"FDA(54)")
|
|---|
| 24 | Q
|
|---|
| 25 | SET D FILE^DIE("","FDA(54)","PSSIENS")
|
|---|
| 26 | I $G(^TMP("DIERR",$J,1)) D ZTQUE
|
|---|
| 27 | Q
|
|---|
| 28 | BULL ; Bulletin for failed update
|
|---|
| 29 | N PSSLN,PSSMSG S PSSLN=0
|
|---|
| 30 | K ^TMP("PSSDIC",$J)
|
|---|
| 31 | S XMSUB="DICITONARY MAINTENANCE (FILE 54) " K XMY
|
|---|
| 32 | S XMTEXT="^TMP(""PSSDIC"",$J,"
|
|---|
| 33 | S XMY($S(DUZ:DUZ,1:.5))=""
|
|---|
| 34 | S XMDUZ=.5 D NOW^%DTC
|
|---|
| 35 | S PSSMSG=" " D SETLN
|
|---|
| 36 | S PSSMSG="The update of file RX CONSULT, NO TRANSFER description failed." D SETLN
|
|---|
| 37 | S PSSMSG=" " D SETLN
|
|---|
| 38 | D ^XMD
|
|---|
| 39 | K ^TMP("PSSDIC",$J),XMY,XMTEXT,XMSUB
|
|---|
| 40 | Q
|
|---|
| 41 | SETLN ; Setting TMP global for bulletin
|
|---|
| 42 | S PSSLN=PSSLN+1
|
|---|
| 43 | S ^TMP("PSSDIC",$J,PSSLN)=PSSMSG
|
|---|
| 44 | Q
|
|---|
| 45 | ZTQUE ;
|
|---|
| 46 | N ZTIO,ZTDTH,ZTDESC,ZTRTN,ZTSAVE
|
|---|
| 47 | S ZTIO="",ZTDTH=$H,$P(ZTDTH,",",2)=$P(ZTDTH,",",2)+60,ZTDESC="PDM UPDATE ERROR"
|
|---|
| 48 | S ZTRTN="BULL^PSSXDIC"
|
|---|
| 49 | D ^%ZTLOAD
|
|---|
| 50 | Q
|
|---|
