| 1 | GMRGRUT3 ;HIRMFO/RM-GMRG ROUTINE UTILITIES ;9/11/95
|
|---|
| 2 | ;;3.0;Text Generator;;Jan 24, 1996
|
|---|
| 3 | EN1 ;SELECT PATIENT CARE PLAN
|
|---|
| 4 | ; INPUT: GMRGRT=PRIME DOC IEN^PD TEXT
|
|---|
| 5 | ; DFN=PATIENT IEN
|
|---|
| 6 | ; (optional) GMRGXPRT=$S(1:ALL PLANS E/E OR NOT,0:ONLY ACTIVE)
|
|---|
| 7 | ; _"^"_$S(1:CAN LAYGO NEW PLANS,0:LAYGO NOT ALLOWED)_"^"_
|
|---|
| 8 | ; $S(1:ENTRY IN ERROR OF PLANS ALLOWED,0:E/E NOT ALLOWED)
|
|---|
| 9 | ; DEFAULT VALUE IS "0^1^0"
|
|---|
| 10 | ; OUTPUT: GMRGPDA=ENTRY IN 124.3
|
|---|
| 11 | ; GMRGOUT=$S(1:ABNORMAL EXIT,0:NORMAL EXIT)
|
|---|
| 12 | Q:'$D(GMRGRT)!'$D(DFN) S GMRGOUT=0,GMRGPDA=-1 S:'$D(GMRGXPRT)#2 GMRGXPRT="0^1^0"
|
|---|
| 13 | S (GMRGZ(0),GMRGZ)=1 F GMRGX=0:0 S GMRGX=$O(^GMR(124.3,"AA",DFN,+GMRGRT,GMRGX)) Q:GMRGX'>0 F GMRGY=0:0 S GMRGY=$O(^GMR(124.3,"AA",DFN,+GMRGRT,GMRGX,GMRGY)) Q:GMRGY'>0 D STRY
|
|---|
| 14 | S GMRGXSEL=GMRGZ-1,GMRGXERR=GMRGZ(0)-1,GMRGXREF="GMRGXSEL"
|
|---|
| 15 | G:GMRGXSEL>0 CPCH
|
|---|
| 16 | YNNP ; IF NO 124.3 ENTRIES EXIST
|
|---|
| 17 | W !,"There is no previous "_$P(GMRGRT,"^",2)_" for this patient."
|
|---|
| 18 | G:'$P(GMRGXPRT,"^",2) Q1:GMRGXERR'>0!'$P(GMRGXPRT,"^"),CPCH
|
|---|
| 19 | W !,"Would you like to add one" S %=1 D YN^DICN S:%=-1 GMRGOUT=1 I '% W !?3,$C(7),"Answer Yes or No." G YNNP
|
|---|
| 20 | D:%=1 NEWCP
|
|---|
| 21 | G Q1
|
|---|
| 22 | ;
|
|---|
| 23 | CPCH ; CHOOSE FROM EXISTING 124.3 ENTRIES
|
|---|
| 24 | I @GMRGXREF>0 W !!,"The following is a list of previous "_$P(GMRGRT,"^",2)_$E("s",("Ss"'[$E($P(GMRGRT,"^",2),$L($P(GMRGRT,"^",2))))),! W:GMRGXREF="GMRGXERR" "that have been entered in error",!
|
|---|
| 25 | F GMRGZ=0:0 S GMRGZ=$O(@(GMRGXREF_"("_GMRGZ_")")) Q:GMRGZ'>0 S GMRGX=((GMRGZ#10)=1&(GMRGZ'=1)),X="" W:GMRGX !,"'^' TO STOP: " R:GMRGX X:DTIME S:GMRGX&(X="^^"!'$T) GMRGOUT=1 Q:(X="^"!GMRGOUT)&GMRGX D PRTC
|
|---|
| 26 | I GMRGOUT Q:GMRGXREF="GMRGXERR" G Q1
|
|---|
| 27 | W !!,"Enter Selection: "
|
|---|
| 28 | R GMRGX:DTIME S:'$T GMRGX="^^"
|
|---|
| 29 | I "^^"[GMRGX S:GMRGX="^^"!(GMRGX="^") GMRGOUT=1 Q:GMRGXREF="GMRGXERR" G Q1
|
|---|
| 30 | S:GMRGX?1L GMRGX=$C($A(GMRGX)-32) S:GMRGXREF="GMRGXERR"&(GMRGX'?1N.N)!(GMRGX["@"&'$P(GMRGXPRT,"^",3)) GMRGX="??"
|
|---|
| 31 | I '(GMRGX?1N.N."@"!(GMRGX="N"&$P(GMRGXPRT,"^",2))!(GMRGX="E"&$P(GMRGXPRT,"^"))) W !?3,$C(7),"ENTER THE NUMBER OF THE SELECTION TO BE CHOSEN" W:$P(GMRGXPRT,"^",3) ",",!?3,"OR THE NUMBER FOLLOWED BY AN '@' TO DELETE A SELECTION"
|
|---|
| 32 | I W:GMRGXREF'="GMRGXERR"&$P(GMRGXPRT,"^",2) ",",!?3,"OR THE LETTER 'N' TO ADD A NEW ",$P(GMRGRT,"^",2) W:GMRGXREF'="GMRGXERR"&$P(GMRGXPRT,"^") ",",!?3,"OR TYPE AN 'E' TO LIST THE PLANS ENTERED IN ERROR" W "." G CPCH
|
|---|
| 33 | I GMRGX?1N.N."@",(+GMRGX<1!(+GMRGX>@GMRGXREF)) W !?3,$C(7),"Select a number in the range 1"_$S(@GMRGXREF>1:"-"_@GMRGXREF,1:"") G CPCH
|
|---|
| 34 | I "Ee"[GMRGX S GMRGXREF="GMRGXERR" D:@GMRGXREF>0 CPCH W:@GMRGXREF'>0 !?5,$C(7),"THERE ARE NO RECORDS ENTERED IN ERROR, TRY AGAIN." S GMRGXREF="GMRGXSEL" G Q1:GMRGPDA>0!GMRGOUT,CPCH
|
|---|
| 35 | I "Nn"[GMRGX D NEWCP G Q1
|
|---|
| 36 | I GMRGX["@" D DELPL G Q1:GMRGOUT,CPCH:+GMRGX<0
|
|---|
| 37 | S GMRGPDA=$P(@(GMRGXREF_"("_+GMRGX_")"),"^",2)_$S(GMRGX'["@":"",1:"^@") Q:GMRGXREF="GMRGXERR"
|
|---|
| 38 | Q1 K %,DA,DIC,DIE,DR,GMRGXERR,GMRGXPRT,GMRGXREF,GMRGXSEL,GMRGX,GMRGY,GMRGZ,X,Y Q
|
|---|
| 39 | PRTC ; PRINT AN ENTRY FROM FILE 124.3
|
|---|
| 40 | W !,$J(GMRGZ,3,0),". " S Y=$P(@(GMRGXREF_"("_GMRGZ_")"),"^") D DT^DIQ S GMRGY=$S($D(^GMR(124.3,$P(@(GMRGXREF_"("_GMRGZ_")"),"^",2),0)):$P(^(0),"^",5),1:""),GMRGY=$S(GMRGY="":"",$D(^VA(200,GMRGY,0)):$P(^(0),"^"),1:"") W ?30,GMRGY
|
|---|
| 41 | Q
|
|---|
| 42 | NEWCP ; ADD A NEW 124.3 ENTRY
|
|---|
| 43 | D NOW^%DTC W !,"Let me create a new record..." S GMRGX=%,X=+GMRGRT,DIC="^GMR(124.3,",DIC(0)="Q",DIC("DR")=".02///^S X=""`""_DFN;.03///^S X=GMRGX" K DD D FILE^DICN S GMRGPDA=+Y
|
|---|
| 44 | Q
|
|---|
| 45 | DELPL ; ENTER A 124.3 ENTRY IN ERROR
|
|---|
| 46 | W !,?3,$C(7),"ARE YOU SURE YOU WANT TO ENTER THIS ",$P(GMRGRT,"^",2)," IN ERROR" S %=0 D YN^DICN I '% W !?5,$C(7),"Answer Yes to enter this selection in error, else answer No." G DELPL
|
|---|
| 47 | S:%=-1 GMRGOUT=1 S:%=2 GMRGX=-1 Q:%'=1
|
|---|
| 48 | S DA=$P(GMRGXSEL(+GMRGX),"^",2),DIE="^GMR(124.3,",DR="5///1" D ^DIE W "."
|
|---|
| 49 | Q
|
|---|
| 50 | STRY ; SET UP GMRGXSEL( AND GMRGXERR( OF 124.3 ENTRIES TO BE SELECTED
|
|---|
| 51 | S X=$S($D(^GMR(124.3,+GMRGY,5)):+^(5),1:0) Q:X&'$P(GMRGXPRT,"^")
|
|---|
| 52 | I 'X S GMRGXSEL(GMRGZ)=(9999999-GMRGX)_"^"_GMRGY,GMRGZ=GMRGZ+1
|
|---|
| 53 | I X S GMRGXERR(GMRGZ(0))=(9999999-GMRGX)_"^"_GMRGY,GMRGZ(0)=GMRGZ(0)+1
|
|---|
| 54 | Q
|
|---|
| 55 | EN4 ; PRUNE A SUBTREE FROM SOME PATIENT DATA SET
|
|---|
| 56 | ; GMRGPDA=ENTRY IN FILE 124.3
|
|---|
| 57 | ; GMRGTERM=ENTRY IN FILE 124.2 WHICH IS THE ROOT OF THE SUBTREE
|
|---|
| 58 | G Q4:'$D(GMRGPDA)!'$D(GMRGTERM)
|
|---|
| 59 | S X=GMRGTERM N GMRGTERM,GMRGOUT,GMRGPRC,GMRGRT,GMRGX,GMRGZZ S GMRGTERM=X
|
|---|
| 60 | S GMRGTERM(0)=$G(^GMRD(124.2,+GMRGTERM,0)),GMRGX=$G(^GMR(124.3,+GMRGPDA,0)) G Q4:GMRGTERM(0)=""!(GMRGX="")
|
|---|
| 61 | S GMRGRT=+GMRGX_"^"_$P($G(^GMRD(124.2,+GMRGX,0)),"^"),GMRGOUT=0 D PTDATA
|
|---|
| 62 | I +GMRGTERM'=+GMRGRT D DELETE^GMRGED6 G Q4
|
|---|
| 63 | F GMRGZZ=0:0 S GMRGZZ=$O(^GMRD(124.2,+GMRGRT,1,GMRGZZ)) Q:GMRGZZ'>0 S GMRGTERM=+$G(^GMRD(124.2,+GMRGRT,1,GMRGZZ,0)),GMRGTERM(0)=$G(^GMRD(124.2,+GMRGTERM,0)) I +GMRGTERM D PTDATA,DELETE^GMRGED6
|
|---|
| 64 | Q4 ;
|
|---|
| 65 | Q
|
|---|
| 66 | PTDATA ;
|
|---|
| 67 | S GMRGX=$O(^GMR(124.3,GMRGPDA,1,"B",GMRGTERM,0)),GMRGX(0)=$P($G(^GMR(124.3,GMRGPDA,1,+GMRGX,0)),"^",2),GMRGPRC=GMRGTERM_"^@^11",GMRGPRC(0)=$P(GMRGTERM(0),"^")_"^"_GMRGX_"^"_GMRGX(0)
|
|---|
| 68 | Q
|
|---|
