| [613] | 1 | PRCP5POS ;WISC/RFJ-post init for inventory version 5 ;29 Jun 94
|
|---|
| 2 | ;;5.0;IFCAP;;4/21/95
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | START ; start post init
|
|---|
| 6 | N DA,DATA,DIK,INVPT,ITEMDA,ITEMDATA,PRCPX,X
|
|---|
| 7 | ; clean up due-ins and due-outs
|
|---|
| 8 | W !!,"Looping inventory points and items, copying due-ins/outs to new fields",!
|
|---|
| 9 | S INVPT=0 F S INVPT=$O(^PRCP(445,INVPT)) Q:'INVPT W "." S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,INVPT,1,ITEMDA)) Q:'ITEMDA S ITEMDATA=$G(^PRCP(445,INVPT,1,ITEMDA,0)) I ITEMDATA'="",'$D(^PRCP(445,INVPT,1,ITEMDA,"DUE")) D
|
|---|
| 10 | . S ^PRCP(445,INVPT,1,ITEMDA,"DUE")=+$P(ITEMDATA,"^",8)_"^"_+$P(ITEMDATA,"^",20)
|
|---|
| 11 | . S $P(^PRCP(445,INVPT,1,ITEMDA,0),"^",8)="",$P(^PRCP(445,INVPT,1,ITEMDA,0),"^",20)=""
|
|---|
| 12 | ; set due-outs in secondaries to zero
|
|---|
| 13 | S INVPT=0 F S INVPT=$O(^PRCP(445,INVPT)) Q:'INVPT W "." I $P($G(^(INVPT,0)),"^",3)="S" S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,INVPT,1,ITEMDA)) Q:'ITEMDA I $D(^PRCP(445,INVPT,1,ITEMDA,"DUE")) S $P(^("DUE"),"^",2)=0
|
|---|
| 14 | ; redirect barcode pointers
|
|---|
| 15 | S X=$O(^PRCT(446.6,"B","INTERMEC TRAKKER 9440",0)) I X S %=0 F S %=$O(^PRCT(446.4,%)) Q:'% I $D(^PRCT(446.4,%,0)) S $P(^(0),"^",9)=X
|
|---|
| 16 | S X=$O(^PRCT(446.6,"B","LABEL 3X1/INTERMEC 8646",0)) I X S %=0 F S %=$O(^PRCT(446.5,%)) Q:'% I $D(^PRCT(446.5,%,0)) S $P(^(0),"^",6)=X
|
|---|
| 17 | ; change barcode routine prcpubar to prcpbalm
|
|---|
| 18 | S X=0 F S X=$O(^PRCT(446.4,X)) Q:'X S %=$P($G(^(X,0)),"^",4) I %["PRCPBAR" S $P(^PRCT(446.4,X,0),"^",4)=$S(%="EN1-PRCPBAR":"PHYSICAL-PRCPBALM",%="EN2-PRCPBAR":"USAGE-PRCPBALM",1:"")
|
|---|
| 19 | ; recompile print labels
|
|---|
| 20 | F PRCPX="PRIMARY/SECONDARY LABEL","WAREHOUSE LABEL","TEST/LABEL 3X1","EXPENDABLE INVENTORY","RUN IRL PROGRAM" S DA=+$O(^PRCT(446.5,"B",PRCPX,0)) I $D(^PRCT(446.5,DA,0)) D
|
|---|
| 21 | . I PRCPX="TEST/LABEL 3X1",'$D(^PRC(440,0)) Q
|
|---|
| 22 | . D COMP^PRCTRED
|
|---|
| 23 | ; clean dd's
|
|---|
| 24 | K ^DD(445.121,0,"ID","WRITE")
|
|---|
| 25 | K ^DD(445.121,0,"NM","MEMBER OF SET/PACK")
|
|---|
| 26 | ; add PRCP options which were deleted from PRC
|
|---|
| 27 | N %,ADDOPT,DISPLAY,OPTION,PRCPOPT
|
|---|
| 28 | F %=1:1 S X=$P($T(OPTION+%),";",3,99) Q:X="" S OPTION(%)=$O(^DIC(19,"B",$P(X,"^"),0)),DISPLAY(%)=$P(X,"^",2,3)
|
|---|
| 29 | S PRCPOPT=$O(^DIC(19,"B","PRCHPM RA MENU",0)) I PRCPOPT F ADDOPT=1 I OPTION(ADDOPT) D ADDOPT(PRCPOPT,OPTION(ADDOPT),+$P(DISPLAY(ADDOPT),"^"))
|
|---|
| 30 | S PRCPOPT=$O(^DIC(19,"B","PRCHUSER PPM",0)) I PRCPOPT F ADDOPT=1 I OPTION(ADDOPT) D ADDOPT(PRCPOPT,OPTION(ADDOPT),+$P(DISPLAY(ADDOPT),"^",2))
|
|---|
| 31 | S PRCPOPT=$O(^DIC(19,"B","PRCHUSER COORDINATOR",0)) I PRCPOPT,OPTION(2) D ADDOPT(PRCPOPT,OPTION(2),0)
|
|---|
| 32 | ; run inits for list manager
|
|---|
| 33 | S X="PRCPL" X:$D(^%ZOSF("TEST")) ^("TEST") I $T D ^PRCPL
|
|---|
| 34 | S X="PRCPONIT" X:$D(^%ZOSF("TEST")) ^("TEST") I $T D ^PRCPONIT
|
|---|
| 35 | ; re-index new cross-references
|
|---|
| 36 | S DIK="^PRCP(445,",DIK(1)=15 D ENALL^DIK
|
|---|
| 37 | S DIK="^PRCP(445.2,",DIK(1)=3 D ENALL^DIK
|
|---|
| 38 | S DIK="^PRCP(445.2,",DIK(1)=13 D ENALL^DIK
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | ;
|
|---|
| 42 | ADDOPT(V1,V2,V3) ;add option da=v2 to menu option da=v1 ; display order=v3
|
|---|
| 43 | ; option is already in the menu
|
|---|
| 44 | I $O(^DIC(19,V1,10,"B",V2,0)) Q
|
|---|
| 45 | I '$D(^DIC(19,V1,0))!('$D(^DIC(19,V2,0))) Q
|
|---|
| 46 | N D0,DA,DD,DI,DIC,DIE,DLAYGO,DQ,DR,X,Y
|
|---|
| 47 | I '$D(^DIC(19,V1,10,0)) S ^(0)="^19.01PI^^"
|
|---|
| 48 | S DIC="^DIC(19,"_V1_",10,",DIC(0)="L",DLAYGO=19,DA(1)=V1,X=V2 S:V3 DIC("DR")="3///"_V3 D FILE^DICN
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | ;
|
|---|
| 52 | ;;option to add ^ display order (prchpm ra menu) ^ display order (prchuser ppm)
|
|---|
| 53 | OPTION ;;options to add to menus
|
|---|
| 54 | ;;PRCP PPM MENU^20^35
|
|---|
| 55 | ;;PRCP POSTED DIETETIC REPORT
|
|---|
