source: FOIAVistA/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWPOST.m@ 923

Last change on this file since 923 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1PSGWPOST ;BHAM/CML-POST INIT CONVERSION ROUTINE ; 27 Dec 93 / 11:12 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3START ;
4 S XQABT4=$H
5 W !!,"Beginning post-init..." S RRFLG=0 D POST1,POST2,POST3,POST4,^PSGWPST1
6FINAL ;Set AR/WS node in file #59.7
7 I '$D(^PS(59.7,1,0)) S X=$S($D(^DD("SITE"))[0:"UNKNOWN",^("SITE")]"":^("SITE"),1:"UNKNOWN"),$P(^PS(59.7,0),"^",3,4)="1^1",^(1,0)=X,^PS(59.7,"B",X,1)=""
8 S $P(^PS(59.7,1,59.99),"^")="2.3",$P(^(59.99),"^",2)=INITDT S:RRFLG $P(^(59.99),"^",6)=INITDT
9QUIT D NOW^%DTC S (DONE,Y)=% X ^DD("DD") S PRT=Y I $D(START) D TIME
10 W !!,"Post-init completed ",PRT,".",!,"AR/WS Version 2.3 has been successfully installed!",!!,"Initialization process took ",MIN," minutes."
11 S XQABT5=$H,X="PSGWINIY" X ^%ZOSF("TEST") I $T D @("^"_X)
12 K AOU,CNT,INITDT,ITM,REA,RET,RRFLG,DONE,MIN,PRT,START,X1,X2,%,X,Y,XQABT1,XQABT2,XQABT3,XQABT4,XQABT5 Q
13TIME S X=START,X1=DONE,Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1) D ^%DTC:X S X=X*1440+Y,MIN=X Q
14POST1 ;Convert RETURN REASON subfield to new location as multiple
15 I $D(^PS(59.7,1,59.99)),$P(^(59.99),"^",6)]"" W !!,"Post-init conversion of RETURN REASON subfield has already been done!" Q
16 W !!,"Now moving existing RETURN REASON data to new location"
17 F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU F ITM=0:0 S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:'ITM F RET=0:0 S RET=$O(^PSI(58.1,AOU,1,ITM,3,RET)) Q:'RET I $D(^PSI(58.1,AOU,1,ITM,3,RET,0)) D MOVE
18 S RRFLG=1 Q
19MOVE ;
20 S REA=$P(^PSI(58.1,AOU,1,ITM,3,RET,0),"^",3)
21 I REA]"" S ^PSI(58.1,AOU,1,ITM,3,RET,1,0)="^58.152S^1^1",^PSI(58.1,AOU,1,ITM,3,RET,1,1,0)=REA W "." S $P(^PSI(58.1,AOU,1,ITM,3,RET,0),"^",3)=""
22 Q
23POST2 ;Re-index "IU" cross-reference in the Drug file (#50)
24 W !!,"Now re-indexing the ""IU"" cross-reference in the Drug file (#50)"
25 K ^PSDRUG("IU") S CNT=0 F DRG=0:0 S DRG=$O(^PSDRUG(DRG)) Q:'DRG I $D(^PSDRUG(DRG,2)),$P(^(2),"^",3)]"" S ^PSDRUG("IU",$P(^(2),"^",3),DRG)="" S CNT=CNT+1 W:CNT#50=0 "."
26 K DRG Q
27POST3 ;Re-initialize sort keys for AOU Inventory Groups
28 Q:'$O(^PSI(58.2,0))
29 W !!,"Now re-initializing sort keys for AOUs in AOU Inventory Group file (#58.2)" D IG^PSGWUTL1
30 Q
31POST4 ;Check for duplicate entries in ITEM subfile (#58.11) of 58.1
32 W !!,"Now checking for duplicate entries in the ITEM subfile of the Pharmacy",!,"AOU Stock file."
33 D NOW^%DTC S PSGWDT=X,CNT=0
34 F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU F DRG=0:0 S DRG=$O(^PSI(58.1,AOU,1,"B",DRG)) Q:'DRG S ITM=$O(^PSI(58.1,AOU,1,"B",DRG,0)) I $O(^PSI(58.1,AOU,1,"B",DRG,ITM)) S ACNT=0 D
35 .S ITMT=ITM,IDT=$P($G(^PSI(58.1,AOU,1,ITMT,0)),"^",3) S:IDT=""!(IDT>PSGWDT) ACNT=1 F S ITMT=$O(^PSI(58.1,AOU,1,"B",DRG,ITMT)) Q:'ITMT D ACHK I ACNT'<2 S CNT=CNT+1
36 I CNT=0 W !!,"No duplicate entries exist !" G EPST4
37 W !!,"Duplicate entries exist.",!,"A MailMan message is being sent to you regarding the problem." D
38 .K XMY S ^TMP("PSGWDUP",$J,1,0)="Duplicate entries exist in the ITEM subfile (#58.11) of the PHARMACY AOU"
39 .S ^TMP("PSGWDUP",$J,2,0)="STOCK file (#58.1). Please execute the following procedures to clean the",^TMP("PSGWDUP",$J,3,0)="subfile:",(^TMP("PSGWDUP",$J,4,0),^TMP("PSGWDUP",$J,5,0))=""
40 .S ^TMP("PSGWDUP",$J,6,0)=" 1. Run the option Duplicate Entry Report to obtain a listing of the",^TMP("PSGWDUP",$J,7,0)=" duplicates with their inventory, on-demand, and return data."
41 .S ^TMP("PSGWDUP",$J,8,0)=""
42 .S ^TMP("PSGWDUP",$J,9,0)=" 2. With the information provided on the report, choose the duplicate",^TMP("PSGWDUP",$J,10,0)=" that needs to be removed.",^TMP("PSGWDUP",$J,11,0)=""
43 .S ^TMP("PSGWDUP",$J,12,0)=" 3. Enter a phrase such as ""DO NOT USE"" in the LOCATION field of the",^TMP("PSGWDUP",$J,13,0)=" inactivated item. The option Stock Items - Enter/Edit will allow"
44 .S ^TMP("PSGWDUP",$J,14,0)=" one to edit the LOCATION field.",(^TMP("PSGWDUP",$J,15,0),^TMP("PSGWDUP",$J,16,0))=""
45 .S ^TMP("PSGWDUP",$J,17,0)=" 4. Inactivate the chosen item in the option Inactivate AOU Stock Item.",^TMP("PSGWDUP",$J,18,0)=""
46 .S ^TMP("PSGWDUP",$J,19,0)="The Purge Dispensing Data option will purge the item from the subfile 100 days from the date of the item's last activity."
47 .S XMSUB="Duplicate entries in ITEM subfile.",XMTEXT="^TMP(""PSGWDUP"",$J," S XMDUZ="INPATIENT PHARMACY AR/WS"
48 .S XMY(DUZ)="" F PSGWDUZ=0:0 S PSGWDUZ=$O(^XUSEC("PSGWMGR",PSGWDUZ)) Q:'PSGWDUZ S XMY(PSGWDUZ)=""
49 .D ^XMD K XMY,^TMP("PSGWDUP",$J),XMDUZ,XMTEXT,XMSUB,PSGWDUZ
50EPST4 K ACNT,IDT,ITMT,PSGWDT
51 Q
52ACHK ;** continue checking for number of active items
53 S IDT=$P($G(^PSI(58.1,AOU,1,ITMT,0)),"^",3) S:IDT=""!(IDT>PSGWDT) ACNT=ACNT+1
54 Q
Note: See TracBrowser for help on using the repository browser.