Changeset 623 for WorldVistAEHR/trunk/r/DIETETICS-FH/FHPRW.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DIETETICS-FH/FHPRW.m
r613 r623 1 FHPRW ;Hines OIFO/REL,RTK - List Dietetic Locations ;5/13/94 14:57 2 ;;5.5;DIETETICS;**12**;Jan 28, 2005;Build 3 3 ; 10/24/07 BAY/KAM FH*5.5*12 CALL 214407 Display new Clinician Field 4 F1 R !!,"Select LOCATION (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRD=0 5 E K DIC S DIC="^FH(119.6,",DIC(0)="EQM" D ^DIC K DIC G:Y<1 F1 S WRD=+Y 6 I 'WRD W !!,"Verifying completeness of room-bed & ward assignments ..." D VER 7 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL 8 I $D(IO("Q")) S FHPGM="Q1^FHPRW",FHLST="WRD" D EN2^FH G KIL 9 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL 10 Q1 ; Print Dietetic Ward Profile 11 K ^TMP($J) D NOW^%DTC S NOW=%,PG=0 I WRD S K1=WRD D Q2 W ! Q 12 F NX=0:0 S NX=$O(^FH(119.6,NX)) Q:NX<1 S X=$G(^(NX,0)),P0=$P(X,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0),WRDN=$P(X,"^",1),^TMP($J,"FHW",P0_"~"_WRDN)=NX 13 S NX="" F S NX=$O(^TMP($J,"FHW",NX)) Q:NX="" S K1=+$G(^(NX)) I K1 D Q2 14 W ! Q 15 Q2 S X=^FH(119.6,K1,0),NODE1=$G(^FH(119.6,K1,1)) D BLD,HDR 16 W !!,"Print Order:",?22,$P(X,"^",4) 17 W !,"Type of Location:",?22,$S($P(X,U,3)="O":"OUTPATIENT",1:"INPATIENT") 18 ; 19 ;10/24/07 BAY/KAM *12 214407 Print new Clinician Multiple field 20 N C1 S C1="" 21 F S C1=$O(^FH(119.6,K1,2,C1)) Q:C1="" D 22 . S Z=$G(^FH(119.6,K1,2,C1,0)) I Z W !,"Assigned Clinician(s):",?22,$P($G(^VA(200,Z,0)),"^",1) 23 ; 24 W !,"Tray Assembly:",?22 S Z=$P(X,"^",5) I Z W $P($G(^FH(119.72,Z,0)),"^",1) S Z=$P(X,"^",17) S:Z="" Z=100 W " (",Z,"%)" 25 W !,"Cafeteria:",?22 S Z=$P(X,"^",6) I Z W $P($G(^FH(119.72,Z,0)),"^",1) S Z=$P(X,"^",18) S:Z="" Z=100 W " (",Z,"%)" 26 W !,"Dining Room:",?22 S Z=$P(X,"^",7) I Z W "Yes" S Z=$P(X,"^",19) S:Z="" Z=100 W " (",Z,"%)" 27 W !,"Supplemental Fdgs.:",?22 S Z=$P(X,"^",9) I Z W $P($G(^FH(119.74,Z,0)),"^",1) 28 W !,"Diet Communication:",?22 S Z=$P(X,"^",8) I Z W $P($G(^FH(119.73,Z,0)),"^",1) 29 W !!,"Admission Diet:",?22 S Z=$P(X,"^",15) I Z W $P($G(^FH(111,Z,0)),"^",1) 30 E I $P(X,"^",16)="Y" W "NO ORDER" 31 W !!,"Review Frequencies:" 32 W !!?5,"NPO's:" S Z=$P(X,"^",11) W:Z ?19,$J(Z,3,0)," days" 33 W ?45,"Admit Status:" S Z=$P(X,"^",14) W:Z ?59,$J(Z,3,0)," days" 34 W !?5,"Tubefeedings:" S Z=$P(X,"^",12) W:Z ?19,$J(Z,3,0)," days" 35 W ?45,"Supp. Fdgs.:" S Z=$P(X,"^",13) W:Z ?59,$J(Z,3,0)," days" 36 W !!?5,"Status I:" S Z=$P(X,"^",20) W:Z ?19,$J(Z,3,0)," days" 37 W ?45,"Status III:" S Z=$P(X,"^",22) W:Z ?59,$J(Z,3,0)," days" 38 W !?5,"Status II:" S Z=$P(X,"^",21) W:Z ?19,$J(Z,3,0)," days" 39 W ?45,"Status IV:" S Z=$P(X,"^",23) W:Z ?59,$J(Z,3,0)," days" 40 S FHY=$P(X,"^",24) W !!,"Bulk Nourishment Orders:",! 41 K P S N=0,NM="" F S NM=$O(^TMP($J,"B",NM)) Q:NM="" S N=N+1,P(N)=$J(^(NM),3,0)_" "_$P(NM,"~",1) 42 I N S (Z,K)=N+1\2 F LL=1:1:Z W !?5,P(LL) S K=K+1 I $D(P(K)) W ?45,P(K) 43 W !!,"Room-Beds Assigned:",! 44 K P S N=0,NM="" F S NM=$O(^TMP($J,"R",NM)) Q:NM="" S N=N+1,P(N)=$P(NM,"~",1) 45 I N S Z=N+3\4 S K(22)=Z,K(39)=2*Z,K(54)=3*Z F LL=1:1:Z W !?5,P(LL) F MM=22,39,54 S K(MM)=K(MM)+1 I $D(P(K(MM))) W ?MM,P(K(MM)) 46 W !!,"Default MAS Wards:",! 47 K P S N=0,NM="" F S NM=$O(^TMP($J,"W",NM)) Q:NM="" S N=N+1,P(N)=$P(NM,"~",1) 48 I N S (Z,K)=N+1\2 F LL=1:1:Z W !?5,P(LL) S K=K+1 I $D(P(K)) W ?45,P(K) 49 W !!,"Print Cafeteria on Tray Tickets: ",$S(FHY="Y":"YES",1:"NO") 50 S FHOL=$P(NODE1,U,1),FHOLFIL=$S(FHOL["SC(":44,FHOL["DIC(42":42,1:0) 51 S FHOLNM="" I FHOLFIL D 52 .S FHOLIEN=$P(FHOL,";",1) 53 .I FHOLFIL=42 S FHOLNM=$P($G(^DIC(42,FHOLIEN,0)),U,1) 54 .I FHOLFIL=44 S FHOLNM=$P($G(^SC(FHOLIEN,0)),U,1) 55 .W !!,"Outpatient Location: ",FHOLNM,! 56 W !,"Maximum # of Days to Schedule Recurring Meal: ",$P(NODE1,U,2) 57 W !,"Number of Days for Review of Recurring Meal: ",$P(NODE1,U,3) 58 W !!,"Non-VA Facility? ",$S($P(NODE1,U,4)="Y":"YES",1:"NO") 59 W ! Q 60 BLD ; Build temp files 61 K ^TMP($J,"B"),^TMP($J,"R"),^TMP($J,"W") 62 F LL=0:0 S LL=$O(^FH(119.6,K1,"BN",LL)) Q:LL<1 S Y=^(LL,0) D B1 63 F LL=0:0 S LL=$O(^FH(119.6,K1,"W",LL)) Q:LL<1 S Y=^(LL,0) D B2 64 F LL=0:0 S LL=$O(^FH(119.6,K1,"R",LL)) Q:LL<1 S Y=^(LL,0) D B3 65 Q 66 B1 S N=+Y,Q=$P(Y,"^",2) Q:'N!('Q) S N=$P($G(^FH(118,N,0)),"^",1) Q:N="" S ^TMP($J,"B",N_"~"_(+Y))=Q Q 67 B2 S N=$P($G(^DIC(42,+Y,0)),"^",1) Q:N="" S ^TMP($J,"W",N_"~"_(+Y))="" Q 68 B3 S N=$P($G(^DG(405.4,+Y,0)),"^",1) Q:N="" S ^TMP($J,"R",N_"~"_(+Y))="" Q 69 HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1,DTP=NOW D DTP^FH W !,$E(DTP,1,9),?19,"D I E T E T I C L O C A T I O N P R O F I L E",?73,"Page ",PG 70 S Y=$P(X,"^",1) W !!?(78-$L(Y)\2),Y 71 W !,"-------------------------------------------------------------------------------",! Q 72 VER ; Verify completeness of data base 73 F LL=0:0 S LL=$O(^DG(405.4,LL)) Q:LL'>0 I '$D(^FH(119.6,"AR",LL)) W !,"Room ",$P(^DG(405.4,LL,0),"^",1)," not assigned to any Dietetic Ward" 74 F LL=0:0 S LL=$O(^DIC(42,LL)) Q:LL'>0 I $G(^DIC(42,LL,"ORDER")),'$D(^FH(119.6,"AW",LL)) W !,"MAS Ward ",$P(^DIC(42,LL,0),"^",1)," not assigned to any Dietetics Ward" 75 Q 76 KIL K ^TMP($J) G KILL^XUSCLEAN 1 FHPRW ;Hines OIFO/REL,RTK - List Dietetic Locations ;5/13/94 14:57 2 ;;5.5;DIETETICS;;Jan 28, 2005 3 F1 R !!,"Select LOCATION (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRD=0 4 E K DIC S DIC="^FH(119.6,",DIC(0)="EQM" D ^DIC K DIC G:Y<1 F1 S WRD=+Y 5 I 'WRD W !!,"Verifying completeness of room-bed & ward assignments ..." D VER 6 W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL 7 I $D(IO("Q")) S FHPGM="Q1^FHPRW",FHLST="WRD" D EN2^FH G KIL 8 U IO D Q1 D ^%ZISC K %ZIS,IOP G KIL 9 Q1 ; Print Dietetic Ward Profile 10 K ^TMP($J) D NOW^%DTC S NOW=%,PG=0 I WRD S K1=WRD D Q2 W ! Q 11 F NX=0:0 S NX=$O(^FH(119.6,NX)) Q:NX<1 S X=$G(^(NX,0)),P0=$P(X,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0),WRDN=$P(X,"^",1),^TMP($J,"FHW",P0_"~"_WRDN)=NX 12 S NX="" F S NX=$O(^TMP($J,"FHW",NX)) Q:NX="" S K1=+$G(^(NX)) I K1 D Q2 13 W ! Q 14 Q2 S X=^FH(119.6,K1,0),NODE1=$G(^FH(119.6,K1,1)) D BLD,HDR 15 W !!,"Print Order:",?22,$P(X,"^",4) 16 W !,"Type of Location:",?22,$S($P(X,U,3)="O":"OUTPATIENT",1:"INPATIENT") 17 W !,"Assigned Clinician:",?22 S Z=$P(X,"^",2) I Z W $P($G(^VA(200,Z,0)),"^",1) 18 W !,"Tray Assembly:",?22 S Z=$P(X,"^",5) I Z W $P($G(^FH(119.72,Z,0)),"^",1) S Z=$P(X,"^",17) S:Z="" Z=100 W " (",Z,"%)" 19 W !,"Cafeteria:",?22 S Z=$P(X,"^",6) I Z W $P($G(^FH(119.72,Z,0)),"^",1) S Z=$P(X,"^",18) S:Z="" Z=100 W " (",Z,"%)" 20 W !,"Dining Room:",?22 S Z=$P(X,"^",7) I Z W "Yes" S Z=$P(X,"^",19) S:Z="" Z=100 W " (",Z,"%)" 21 W !,"Supplemental Fdgs.:",?22 S Z=$P(X,"^",9) I Z W $P($G(^FH(119.74,Z,0)),"^",1) 22 W !,"Diet Communication:",?22 S Z=$P(X,"^",8) I Z W $P($G(^FH(119.73,Z,0)),"^",1) 23 W !!,"Admission Diet:",?22 S Z=$P(X,"^",15) I Z W $P($G(^FH(111,Z,0)),"^",1) 24 E I $P(X,"^",16)="Y" W "NO ORDER" 25 W !!,"Review Frequencies:" 26 W !!?5,"NPO's:" S Z=$P(X,"^",11) W:Z ?19,$J(Z,3,0)," days" 27 W ?45,"Admit Status:" S Z=$P(X,"^",14) W:Z ?59,$J(Z,3,0)," days" 28 W !?5,"Tubefeedings:" S Z=$P(X,"^",12) W:Z ?19,$J(Z,3,0)," days" 29 W ?45,"Supp. Fdgs.:" S Z=$P(X,"^",13) W:Z ?59,$J(Z,3,0)," days" 30 W !!?5,"Status I:" S Z=$P(X,"^",20) W:Z ?19,$J(Z,3,0)," days" 31 W ?45,"Status III:" S Z=$P(X,"^",22) W:Z ?59,$J(Z,3,0)," days" 32 W !?5,"Status II:" S Z=$P(X,"^",21) W:Z ?19,$J(Z,3,0)," days" 33 W ?45,"Status IV:" S Z=$P(X,"^",23) W:Z ?59,$J(Z,3,0)," days" 34 S FHY=$P(X,"^",24) W !!,"Bulk Nourishment Orders:",! 35 K P S N=0,NM="" F S NM=$O(^TMP($J,"B",NM)) Q:NM="" S N=N+1,P(N)=$J(^(NM),3,0)_" "_$P(NM,"~",1) 36 I N S (Z,K)=N+1\2 F LL=1:1:Z W !?5,P(LL) S K=K+1 I $D(P(K)) W ?45,P(K) 37 W !!,"Room-Beds Assigned:",! 38 K P S N=0,NM="" F S NM=$O(^TMP($J,"R",NM)) Q:NM="" S N=N+1,P(N)=$P(NM,"~",1) 39 I N S Z=N+3\4 S K(22)=Z,K(39)=2*Z,K(54)=3*Z F LL=1:1:Z W !?5,P(LL) F MM=22,39,54 S K(MM)=K(MM)+1 I $D(P(K(MM))) W ?MM,P(K(MM)) 40 W !!,"Default MAS Wards:",! 41 K P S N=0,NM="" F S NM=$O(^TMP($J,"W",NM)) Q:NM="" S N=N+1,P(N)=$P(NM,"~",1) 42 I N S (Z,K)=N+1\2 F LL=1:1:Z W !?5,P(LL) S K=K+1 I $D(P(K)) W ?45,P(K) 43 W !!,"Print Cafeteria on Tray Tickets: ",$S(FHY="Y":"YES",1:"NO") 44 S FHOL=$P(NODE1,U,1),FHOLFIL=$S(FHOL["SC(":44,FHOL["DIC(42":42,1:0) 45 S FHOLNM="" I FHOLFIL D 46 .S FHOLIEN=$P(FHOL,";",1) 47 .I FHOLFIL=42 S FHOLNM=$P($G(^DIC(42,FHOLIEN,0)),U,1) 48 .I FHOLFIL=44 S FHOLNM=$P($G(^SC(FHOLIEN,0)),U,1) 49 .W !!,"Outpatient Location: ",FHOLNM,! 50 W !,"Maximum # of Days to Schedule Recurring Meal: ",$P(NODE1,U,2) 51 W !,"Number of Days for Review of Recurring Meal: ",$P(NODE1,U,3) 52 W !!,"Non-VA Facility? ",$S($P(NODE1,U,4)="Y":"YES",1:"NO") 53 W ! Q 54 BLD ; Build temp files 55 K ^TMP($J,"B"),^TMP($J,"R"),^TMP($J,"W") 56 F LL=0:0 S LL=$O(^FH(119.6,K1,"BN",LL)) Q:LL<1 S Y=^(LL,0) D B1 57 F LL=0:0 S LL=$O(^FH(119.6,K1,"W",LL)) Q:LL<1 S Y=^(LL,0) D B2 58 F LL=0:0 S LL=$O(^FH(119.6,K1,"R",LL)) Q:LL<1 S Y=^(LL,0) D B3 59 Q 60 B1 S N=+Y,Q=$P(Y,"^",2) Q:'N!('Q) S N=$P($G(^FH(118,N,0)),"^",1) Q:N="" S ^TMP($J,"B",N_"~"_(+Y))=Q Q 61 B2 S N=$P($G(^DIC(42,+Y,0)),"^",1) Q:N="" S ^TMP($J,"W",N_"~"_(+Y))="" Q 62 B3 S N=$P($G(^DG(405.4,+Y,0)),"^",1) Q:N="" S ^TMP($J,"R",N_"~"_(+Y))="" Q 63 HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1,DTP=NOW D DTP^FH W !,$E(DTP,1,9),?19,"D I E T E T I C L O C A T I O N P R O F I L E",?73,"Page ",PG 64 S Y=$P(X,"^",1) W !!?(78-$L(Y)\2),Y 65 W !,"-------------------------------------------------------------------------------",! Q 66 VER ; Verify completeness of data base 67 F LL=0:0 S LL=$O(^DG(405.4,LL)) Q:LL'>0 I '$D(^FH(119.6,"AR",LL)) W !,"Room ",$P(^DG(405.4,LL,0),"^",1)," not assigned to any Dietetic Ward" 68 F LL=0:0 S LL=$O(^DIC(42,LL)) Q:LL'>0 I $G(^DIC(42,LL,"ORDER")),'$D(^FH(119.6,"AW",LL)) W !,"MAS Ward ",$P(^DIC(42,LL,0),"^",1)," not assigned to any Dietetics Ward" 69 Q 70 KIL K ^TMP($J) G KILL^XUSCLEAN
Note:
See TracChangeset
for help on using the changeset viewer.