| 1 | PSDIPOS1 ;BIR/LTL-Post Init for Control Subs (cont'd) ; 21 Feb 95
|
---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
---|
| 3 | CHECK ;check pharmacy system file for conversion completion date
|
---|
| 4 | N PSDSYS S PSDSYS=$O(^PS(59.7,0)) G:$P($G(^PS(59.7,+PSDSYS,70)),U,4) QUIT
|
---|
| 5 | INF D MES^XPDUTL("I need to convert and clean up data in the DRUG ACCOUNTABILITY STATS file.")
|
---|
| 6 | CONV ;convert monthly activity entries to be FM compatible
|
---|
| 7 | D MES^XPDUTL("Now, I need to add 00 to the monthly activity multiple so its FM compatible.")
|
---|
| 8 | S PSDLOC=0 N PSDR,PSDMON
|
---|
| 9 | F S PSDLOC=$O(^PSD(58.8,PSDLOC)) Q:'PSDLOC D
|
---|
| 10 | .S PSDR=0 S PSD="Working on "_$P($G(^PSD(58.8,+PSDLOC,0)),U)
|
---|
| 11 | .D MES^XPDUTL(PSD) K PSD
|
---|
| 12 | .F S PSDR=$O(^PSD(58.8,+PSDLOC,1,PSDR)) Q:'PSDR D
|
---|
| 13 | ..S PSDMON=0 D MES^XPDUTL(".")
|
---|
| 14 | ..F S PSDMON=$O(^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON)) Q:'PSDMON!($L(PSDMON)>5) D
|
---|
| 15 | ...;create the new node with data
|
---|
| 16 | ...S PSDMON(1)=PSDMON*100,^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON(1),0)=$G(^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON,0)),$P(^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON(1),0),U)=PSDMON(1)
|
---|
| 17 | ...;kill the old one
|
---|
| 18 | ...S DIK="^PSD(58.8,+PSDLOC,1,+PSDR,5,",DA=PSDMON,DA(2)=PSDLOC
|
---|
| 19 | ...S DA(1)=PSDR D ^DIK K DIK,DA
|
---|
| 20 | ..;reindex the new multiple for this drug
|
---|
| 21 | ..S DIK="^PSD(58.8,+PSDLOC,1,+PSDR,5,",DA(2)=PSDLOC,DA(1)=PSDR
|
---|
| 22 | ..S DIK(1)=".01" D ENALL^DIK K DIK,DA
|
---|
| 23 | COMP ;enter conversion completion date in pharmacy system file
|
---|
| 24 | S PSD(1)="I' done with the conversion.",PSD(2)="I'll now store a completion date in your PHARMACY SYSTEM (#59.7) file." D MES^XPDUTL(.PSD) K PSD
|
---|
| 25 | D DT^DICRW
|
---|
| 26 | S DIE="^PS(59.7,",DA=PSDSYS,DR="71///^S X=DT" D ^DIE
|
---|
| 27 | K DIE,DR
|
---|
| 28 | QUIT D MES^XPDUTL("Finished.")
|
---|
| 29 | ;S XQABT5=$H,X="PSDINITY" X ^%ZOSF("TEST") I $T D @("^"_X)
|
---|
| 30 | D:+$G(^DIC(9.4,+$O(^DIC(9.4,"B","HEALTH LEVEL SEVEN",0)),"VERSION"))'<1.5 ^PSDHLK
|
---|
| 31 | K DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSD,PSDLOC,PSDSYS,X,Y
|
---|
| 32 | Q
|
---|