ACMEP ; IHS/TUCSON/TMJ - EDIT SEQUENCE DATA ENTRY ;
;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
;EDITING SEQUENCE FOR PATIENT DATA ENTRY
;ENTRY DISPLAY OF EXISTING DATA
;HEADER DISPLAY FORMAT CALLED FROM ACMCTRL2
;ENTRY FIELD & POSITION NUMBER DISPLAYS CALLED FROM ACMCTRL1
;
;
EN D INIT
EN1 D HEAD
G EXIT:$D(ACMPROB)
D LIST:'$D(ACMCT)&'$D(ACMREG)
I '$D(ACMREG),'$D(ACMCT),'$D(ACMNT),'$D(ACMCH) D DIC
I $D(ACMDEL) K ACMDEL G EN1
I '$D(ACMQUIT),'$D(ACMOUT) D DIE I ACMDIC=44,$D(ACMY),$D(^ACM(44.3,"AC",ACMY)) S DIR(0)="YO",DIR("A")="Add/Edit Standard Interventions",DIR("B")="NO" W ! D ^DIR K DIR I Y=1 S ACMDXDA=ACMY D EN2^ACMDXIT
G EN1:'$D(ACMQUIT)&'$D(ACMOUT)&'$D(ACMCT)&'$D(ACMCH)&'$D(ACMCR)
EXIT K ACMPROB,ACMENTRY,ACMREG,ACMCT,ACMNT,ACMCH,ACMFM,ACMTL,ACMEN1,ACMY
K ACMEN,ACMLE,ACMDIQF,ACMDIC,DIC,DR,DA,ACMPOSS,ACMDIQF,ACMDR,ACMDIC
K ACMDIC1,ACMDIC2,ACMFLD,ACMUTIL,ACMDICK
Q
;
INIT K ACMQUIT,ACMOUT
I $D(ACMEP) S ACMEN1=$P(ACMENTRY," ;;")_1,ACMLE=$P($T(@ACMEN1^ACMCTRL2),";;",2)
S ACMTL=$P(ACMENTRY,";;",2),ACMDIC=$P(ACMENTRY,";;",3),ACMDR=$P(ACMENTRY,";;",4),ACMDIQF=$P(ACMENTRY,";;",5),ACMPOSS=$P(ACMENTRY,";;",6)
Q
;
DIC S DIC="^ACM("_ACMDIC_".1,",DIC("A")=$P(ACMENTRY,";;",7),DIC(0)="AEMQZL",ACMDIC1="^ACM("_ACMDIC_")",ACMDIC2="^ACM("_ACMDIC_".1)"
S:ACMDIC["57" DIC="^AUTTMSR("
S:$D(ACMFM) DIC="^AUPNPAT("
I DIC["AUPNPAT"!(ACMDIC=47) S DIC(0)="AEMQZ"
I $P(^ACM(41.1,ACMRG,0),U,11)'=1 S DIC(0)="AEMQZ"
I '$P(^ACM(41.1,ACMRG,0),U,8) S:ACMDIC'=41&(ACMDIC'=46)&(ACMDIC'=57)&(ACMDIC'=50) DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"
S:ACMDIC=47 DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"
W !
D ^DIC K DIC,DA
I $E(X)=U!(X="")!(Y=-1) S ACMQUIT="" S:X["^" ACMOUT="" Q
S ACMY=+Y
I $P(Y,U,3)=1 S DR=".02T;.03///"_ACMRGNA D ADD
I '$D(@ACMDIC2@(ACMY,"RG","B",ACMRG)) S DR=".03///"_ACMRGNA D ADD
I $D(@ACMDIC1@("AC",ACMRG,ACMPTNO,ACMY)) S DA=(^(ACMY)) D DEL Q
DICN ;EP
K DIC,DD,DR
S X=ACMY,DIC="^ACM("_ACMDIC_",",DIC(0)="L",DIC("DR")=".02////"_ACMPTNO_";.03////"_ACMRGDFN_";.04////"_ACMRG
K DD,DO D FILE^DICN K DIC,DR,DD S (ACMDA,DA)=+Y
Q
;
ADD S DIE="^ACM("_ACMDIC_".1,",DA=ACMY
D ^DIE S Y=DA K DIE,DA,DR
Q
;
DIE ;EP
S:ACMDIC=41 DA=ACMRGDFN
S DR=ACMDR,DIE="^ACM("_ACMDIC_","
W:'$D(ACMREG)&'$D(ACMNT)&'$D(ACMCH) !
D DIE1
Q
;
DIE1 W ! D ^DIE K DIC,DIE,DA,DR
I $D(Y) S ACMOUT="" Q
S DIE="^ACM(41,",DA=ACMRGDFN,DR="11///TODAY" D ^DIE K DIC,DIE,DA,DR
Q
;
DEL W !!?10,"Delete this entry"
S %=2 D YN^DICN
I %=-1 S ACMQUIT="" Q
I %=0 W !!?10,"Type 'Y' to delete entry or 'N' to retain it." G DEL
I %Y='"",(%Y'?1"Y".E)!(%Y'?1"N".E) W !!?10,"Type 'Y' to delete entry or 'N' to retain it." G DEL
I %=2 Q
S DIC="^ACM("_ACMDIC_",",X=+Y,DIC(0)="E"
D ^DIC K DIC
S DIE="^ACM("_ACMDIC_",",DR=".01///@"
D DIE1 S ACMDEL=""
Q
;
HEAD D HEAD^ACMMENU
W !!?14,$S(ACMTL["PCC":" View ",1:"Update "),@ACMRVON,ACMTL,@ACMRVOFF,!?17,"for ",@ACMRVON,ACMPTNA2,@ACMRVOFF
X ACMLE
Q
;
LIST S DIC="90022"_ACMDIC,ACMDIC1="^ACM("_ACMDIC_")",ACMDIC2="^ACM("_ACMDIC_","
I ACMDIC=41 S DA=ACMRGDFN D LIST2 Q
S ACMA=""
F ACMI=0:0 S ACMA=$O(@ACMDIC1@("AC",ACMRG,ACMPTNO,ACMA)) Q:ACMA="" S DA=^(ACMA) D LIST2
S ACMDICK="90022"_ACMDIC
K ^UTILITY("DIQ1",$J,ACMDICK),ACMA,ACMI,ACMDIC1
Q
;
LIST2 S ACMCNT=$L(ACMDIQF,";"),DR=ACMDIQF
D EN^DIQ1
S ACMUTIL="^UTILITY(""DIQ1"""_","_$J_",90022"_ACMDIC_","_DA_")"
W !
F ACMJ=1:1:ACMCNT S ACMFLD=$P(ACMDIQF,";",ACMJ),ACMPOS=$P(ACMPOSS,";",ACMJ) D
.S G=$P(ACMUTIL,")")_","_ACMFLD_",1)" I $D(@G) D WP Q
.S ACMX=$S($D(@ACMUTIL@(ACMFLD)):^(ACMFLD),1:"") W:ACMX'="" ?ACMPOS,ACMX
.Q
K ACMJ,ACMUTIL,ACMFLD,ACMPOS
Q
WP ;Display of Word Processing Field
K ^UTILITY($J,"W")
S ACMG=$P(ACMUTIL,")")_","_ACMFLD_",ACMI)"
S ACMI=0 F S ACMI=$O(@ACMG) Q:ACMI="" D WP2
D WPDISP
Q
;
WP2 ;WP Length Format from 1-40 Characters rather than 80 standard
;
S DIWL=1,DIWR=40,X=@ACMG D ^DIWP
Q
WPDISP ;
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z W ?ACMPOS,^UTILITY($J,"W",DIWL,Z,0),!
K ^UTILITY($J,"W")
Q
ACMEP ; IHS/TUCSON/TMJ - EDIT SEQUENCE DATA ENTRY ;
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996
+2 ;EDITING SEQUENCE FOR PATIENT DATA ENTRY
+3 ;ENTRY DISPLAY OF EXISTING DATA
+4 ;HEADER DISPLAY FORMAT CALLED FROM ACMCTRL2
+5 ;ENTRY FIELD & POSITION NUMBER DISPLAYS CALLED FROM ACMCTRL1
+6 ;
+7 ;
EN DO INIT
EN1 DO HEAD
+1 IF $DATA(ACMPROB)
GOTO EXIT
+2 IF '$DATA(ACMCT)&'$DATA(ACMREG)
DO LIST
+3 IF '$DATA(ACMREG)
IF '$DATA(ACMCT)
IF '$DATA(ACMNT)
IF '$DATA(ACMCH)
DO DIC
+4 IF $DATA(ACMDEL)
KILL ACMDEL
GOTO EN1
+5 IF '$DATA(ACMQUIT)
IF '$DATA(ACMOUT)
DO DIE
IF ACMDIC=44
IF $DATA(ACMY)
IF $DATA(^ACM(44.3,"AC",ACMY))
SET DIR(0)="YO"
SET DIR("A")="Add/Edit Standard Interventions"
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
IF Y=1
SET ACMDXDA=ACMY
DO EN2^ACMDXIT
+6 IF '$DATA(ACMQUIT)&'$DATA(ACMOUT)&'$DATA(ACMCT)&'$DATA(ACMCH)&'$DATA(ACMCR)
GOTO EN1
EXIT KILL ACMPROB,ACMENTRY,ACMREG,ACMCT,ACMNT,ACMCH,ACMFM,ACMTL,ACMEN1,ACMY
+1 KILL ACMEN,ACMLE,ACMDIQF,ACMDIC,DIC,DR,DA,ACMPOSS,ACMDIQF,ACMDR,ACMDIC
+2 KILL ACMDIC1,ACMDIC2,ACMFLD,ACMUTIL,ACMDICK
+3 QUIT
+4 ;
INIT KILL ACMQUIT,ACMOUT
+1 IF $DATA(ACMEP)
SET ACMEN1=$PIECE(ACMENTRY," ;;")_1
SET ACMLE=$PIECE($TEXT(@ACMEN1^ACMCTRL2),";;",2)
+2 SET ACMTL=$PIECE(ACMENTRY,";;",2)
SET ACMDIC=$PIECE(ACMENTRY,";;",3)
SET ACMDR=$PIECE(ACMENTRY,";;",4)
SET ACMDIQF=$PIECE(ACMENTRY,";;",5)
SET ACMPOSS=$PIECE(ACMENTRY,";;",6)
+3 QUIT
+4 ;
DIC SET DIC="^ACM("_ACMDIC_".1,"
SET DIC("A")=$PIECE(ACMENTRY,";;",7)
SET DIC(0)="AEMQZL"
SET ACMDIC1="^ACM("_ACMDIC_")"
SET ACMDIC2="^ACM("_ACMDIC_".1)"
+1 IF ACMDIC["57"
SET DIC="^AUTTMSR("
+2 IF $DATA(ACMFM)
SET DIC="^AUPNPAT("
+3 IF DIC["AUPNPAT"!(ACMDIC=47)
SET DIC(0)="AEMQZ"
+4 IF $PIECE(^ACM(41.1,ACMRG,0),U,11)'=1
SET DIC(0)="AEMQZ"
+5 IF '$PIECE(^ACM(41.1,ACMRG,0),U,8)
IF ACMDIC'=41&(ACMDIC'=46)&(ACMDIC'=57)&(ACMDIC'=50)
SET DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"
+6 IF ACMDIC=47
SET DIC("S")="I $D(@ACMDIC2@(+Y,""RG"",""B"",ACMRG))"
+7 WRITE !
+8 DO ^DIC
KILL DIC,DA
+9 IF $EXTRACT(X)=U!(X="")!(Y=-1)
SET ACMQUIT=""
IF X["^"
SET ACMOUT=""
QUIT
+10 SET ACMY=+Y
+11 IF $PIECE(Y,U,3)=1
SET DR=".02T;.03///"_ACMRGNA
DO ADD
+12 IF '$DATA(@ACMDIC2@(ACMY,"RG","B",ACMRG))
SET DR=".03///"_ACMRGNA
DO ADD
+13 IF $DATA(@ACMDIC1@("AC",ACMRG,ACMPTNO,ACMY))
SET DA=(^(ACMY))
DO DEL
QUIT
DICN ;EP
+1 KILL DIC,DD,DR
+2 SET X=ACMY
SET DIC="^ACM("_ACMDIC_","
SET DIC(0)="L"
SET DIC("DR")=".02////"_ACMPTNO_";.03////"_ACMRGDFN_";.04////"_ACMRG
+3 KILL DD,DO
DO FILE^DICN
KILL DIC,DR,DD
SET (ACMDA,DA)=+Y
+4 QUIT
+5 ;
ADD SET DIE="^ACM("_ACMDIC_".1,"
SET DA=ACMY
+1 DO ^DIE
SET Y=DA
KILL DIE,DA,DR
+2 QUIT
+3 ;
DIE ;EP
+1 IF ACMDIC=41
SET DA=ACMRGDFN
+2 SET DR=ACMDR
SET DIE="^ACM("_ACMDIC_","
+3 IF '$DATA(ACMREG)&'$DATA(ACMNT)&'$DATA(ACMCH)
WRITE !
+4 DO DIE1
+5 QUIT
+6 ;
DIE1 WRITE !
DO ^DIE
KILL DIC,DIE,DA,DR
+1 IF $DATA(Y)
SET ACMOUT=""
QUIT
+2 SET DIE="^ACM(41,"
SET DA=ACMRGDFN
SET DR="11///TODAY"
DO ^DIE
KILL DIC,DIE,DA,DR
+3 QUIT
+4 ;
DEL WRITE !!?10,"Delete this entry"
+1 SET %=2
DO YN^DICN
+2 IF %=-1
SET ACMQUIT=""
QUIT
+3 IF %=0
WRITE !!?10,"Type 'Y' to delete entry or 'N' to retain it."
GOTO DEL
+4 IF %Y='""
IF (%Y'?1"Y".E)!(%Y'?1"N".E)
WRITE !!?10,"Type 'Y' to delete entry or 'N' to retain it."
GOTO DEL
+5 IF %=2
QUIT
+6 SET DIC="^ACM("_ACMDIC_","
SET X=+Y
SET DIC(0)="E"
+7 DO ^DIC
KILL DIC
+8 SET DIE="^ACM("_ACMDIC_","
SET DR=".01///@"
+9 DO DIE1
SET ACMDEL=""
+10 QUIT
+11 ;
HEAD DO HEAD^ACMMENU
+1 WRITE !!?14,$SELECT(ACMTL["PCC":" View ",1:"Update "),@ACMRVON,ACMTL,@ACMRVOFF,!?17,"for ",@ACMRVON,ACMPTNA2,@ACMRVOFF
+2 XECUTE ACMLE
+3 QUIT
+4 ;
LIST SET DIC="90022"_ACMDIC
SET ACMDIC1="^ACM("_ACMDIC_")"
SET ACMDIC2="^ACM("_ACMDIC_","
+1 IF ACMDIC=41
SET DA=ACMRGDFN
DO LIST2
QUIT
+2 SET ACMA=""
+3 FOR ACMI=0:0
SET ACMA=$ORDER(@ACMDIC1@("AC",ACMRG,ACMPTNO,ACMA))
IF ACMA=""
QUIT
SET DA=^(ACMA)
DO LIST2
+4 SET ACMDICK="90022"_ACMDIC
+5 KILL ^UTILITY("DIQ1",$JOB,ACMDICK),ACMA,ACMI,ACMDIC1
+6 QUIT
+7 ;
LIST2 SET ACMCNT=$LENGTH(ACMDIQF,";")
SET DR=ACMDIQF
+1 DO EN^DIQ1
+2 SET ACMUTIL="^UTILITY(""DIQ1"""_","_$JOB_",90022"_ACMDIC_","_DA_")"
+3 WRITE !
+4 FOR ACMJ=1:1:ACMCNT
SET ACMFLD=$PIECE(ACMDIQF,";",ACMJ)
SET ACMPOS=$PIECE(ACMPOSS,";",ACMJ)
Begin DoDot:1
+5 SET G=$PIECE(ACMUTIL,")")_","_ACMFLD_",1)"
IF $DATA(@G)
DO WP
QUIT
+6 SET ACMX=$SELECT($DATA(@ACMUTIL@(ACMFLD)):^(ACMFLD),1:"")
IF ACMX'=""
WRITE ?ACMPOS,ACMX
+7 QUIT
End DoDot:1
+8 KILL ACMJ,ACMUTIL,ACMFLD,ACMPOS
+9 QUIT
WP ;Display of Word Processing Field
+1 KILL ^UTILITY($JOB,"W")
+2 SET ACMG=$PIECE(ACMUTIL,")")_","_ACMFLD_",ACMI)"
+3 SET ACMI=0
FOR
SET ACMI=$ORDER(@ACMG)
IF ACMI=""
QUIT
DO WP2
+4 DO WPDISP
+5 QUIT
+6 ;
WP2 ;WP Length Format from 1-40 Characters rather than 80 standard
+1 ;
+2 SET DIWL=1
SET DIWR=40
SET X=@ACMG
DO ^DIWP
+3 QUIT
WPDISP ;
+1 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
WRITE ?ACMPOS,^UTILITY($JOB,"W",DIWL,Z,0),!
+2 KILL ^UTILITY($JOB,"W")
+3 QUIT
