- PSDIPOS1 ;BIR/LTL-Post Init for Control Subs (cont'd) ; 21 Feb 95
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- CHECK ;check pharmacy system file for conversion completion date
- N PSDSYS S PSDSYS=$O(^PS(59.7,0)) G:$P($G(^PS(59.7,+PSDSYS,70)),U,4) QUIT
- INF D MES^XPDUTL("I need to convert and clean up data in the DRUG ACCOUNTABILITY STATS file.")
- CONV ;convert monthly activity entries to be FM compatible
- D MES^XPDUTL("Now, I need to add 00 to the monthly activity multiple so its FM compatible.")
- S PSDLOC=0 N PSDR,PSDMON
- F S PSDLOC=$O(^PSD(58.8,PSDLOC)) Q:'PSDLOC D
- .S PSDR=0 S PSD="Working on "_$P($G(^PSD(58.8,+PSDLOC,0)),U)
- .D MES^XPDUTL(PSD) K PSD
- .F S PSDR=$O(^PSD(58.8,+PSDLOC,1,PSDR)) Q:'PSDR D
- ..S PSDMON=0 D MES^XPDUTL(".")
- ..F S PSDMON=$O(^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON)) Q:'PSDMON!($L(PSDMON)>5) D
- ...;create the new node with data
- ...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)
- ...;kill the old one
- ...S DIK="^PSD(58.8,+PSDLOC,1,+PSDR,5,",DA=PSDMON,DA(2)=PSDLOC
- ...S DA(1)=PSDR D ^DIK K DIK,DA
- ..;reindex the new multiple for this drug
- ..S DIK="^PSD(58.8,+PSDLOC,1,+PSDR,5,",DA(2)=PSDLOC,DA(1)=PSDR
- ..S DIK(1)=".01" D ENALL^DIK K DIK,DA
- COMP ;enter conversion completion date in pharmacy system file
- 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
- D DT^DICRW
- S DIE="^PS(59.7,",DA=PSDSYS,DR="71///^S X=DT" D ^DIE
- K DIE,DR
- QUIT D MES^XPDUTL("Finished.")
- ;S XQABT5=$H,X="PSDINITY" X ^%ZOSF("TEST") I $T D @("^"_X)
- D:+$G(^DIC(9.4,+$O(^DIC(9.4,"B","HEALTH LEVEL SEVEN",0)),"VERSION"))'<1.5 ^PSDHLK
- K DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSD,PSDLOC,PSDSYS,X,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDIPOS1 1849 printed Jan 18, 2025@02:47:40 Page 2
- PSDIPOS1 ;BIR/LTL-Post Init for Control Subs (cont'd) ; 21 Feb 95
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- CHECK ;check pharmacy system file for conversion completion date
- +1 NEW PSDSYS
- SET PSDSYS=$ORDER(^PS(59.7,0))
- if $PIECE($GET(^PS(59.7,+PSDSYS,70)),U,4)
- GOTO QUIT
- INF DO MES^XPDUTL("I need to convert and clean up data in the DRUG ACCOUNTABILITY STATS file.")
- CONV ;convert monthly activity entries to be FM compatible
- +1 DO MES^XPDUTL("Now, I need to add 00 to the monthly activity multiple so its FM compatible.")
- +2 SET PSDLOC=0
- NEW PSDR,PSDMON
- +3 FOR
- SET PSDLOC=$ORDER(^PSD(58.8,PSDLOC))
- if 'PSDLOC
- QUIT
- Begin DoDot:1
- +4 SET PSDR=0
- SET PSD="Working on "_$PIECE($GET(^PSD(58.8,+PSDLOC,0)),U)
- +5 DO MES^XPDUTL(PSD)
- KILL PSD
- +6 FOR
- SET PSDR=$ORDER(^PSD(58.8,+PSDLOC,1,PSDR))
- if 'PSDR
- QUIT
- Begin DoDot:2
- +7 SET PSDMON=0
- DO MES^XPDUTL(".")
- +8 FOR
- SET PSDMON=$ORDER(^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON))
- if 'PSDMON!($LENGTH(PSDMON)>5)
- QUIT
- Begin DoDot:3
- +9 ;create the new node with data
- +10 SET PSDMON(1)=PSDMON*100
- SET ^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON(1),0)=$GET(^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON,0))
- SET $PIECE(^PSD(58.8,+PSDLOC,1,+PSDR,5,PSDMON(1),0),U)=PSDMON(1)
- +11 ;kill the old one
- +12 SET DIK="^PSD(58.8,+PSDLOC,1,+PSDR,5,"
- SET DA=PSDMON
- SET DA(2)=PSDLOC
- +13 SET DA(1)=PSDR
- DO ^DIK
- KILL DIK,DA
- End DoDot:3
- +14 ;reindex the new multiple for this drug
- +15 SET DIK="^PSD(58.8,+PSDLOC,1,+PSDR,5,"
- SET DA(2)=PSDLOC
- SET DA(1)=PSDR
- +16 SET DIK(1)=".01"
- DO ENALL^DIK
- KILL DIK,DA
- End DoDot:2
- End DoDot:1
- COMP ;enter conversion completion date in pharmacy system file
- +1 SET PSD(1)="I' done with the conversion."
- SET PSD(2)="I'll now store a completion date in your PHARMACY SYSTEM (#59.7) file."
- DO MES^XPDUTL(.PSD)
- KILL PSD
- +2 DO DT^DICRW
- +3 SET DIE="^PS(59.7,"
- SET DA=PSDSYS
- SET DR="71///^S X=DT"
- DO ^DIE
- +4 KILL DIE,DR
- QUIT DO MES^XPDUTL("Finished.")
- +1 ;S XQABT5=$H,X="PSDINITY" X ^%ZOSF("TEST") I $T D @("^"_X)
- +2 if +$GET(^DIC(9.4,+$ORDER(^DIC(9.4,"B","HEALTH LEVEL SEVEN",0)),"VERSION"))'<1.5
- DO ^PSDHLK
- +3 KILL DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSD,PSDLOC,PSDSYS,X,Y
- +4 QUIT