OR628P ;NA/AJB - Patient Updater for PACT Act ;Nov 06, 2024@12:58:46
;;3.0;ORDER ENTRY/RESULTS REPORTING;**628**;Dec 17, 1997;Build 13
;
; Reference to ^DIC in ICR #10006
; Reference to FIND1^DIC in ICR #2051
; Reference to UPDATE^DIE in ICR #2053
; Reference to ^DIR in ICR #10026
; Reference to FMTE^XLFDT in ICR #10103
; Reference to $$NOW^XLFDT in ICR #10103
; Reference to $$PROD^XUPROD in ICR #4440
;
Q
PATIENT ; update patient data for PACT Act
; testing only/non-production accounts only
I +$$PROD^XUPROD Q
N DFN S DFN=$$GPT Q:DFN'>0
N DATA S DATA=$G(^DPT(+DFN,.321))
N PGI,DLU S PGI=$P(DATA,U,17),DLU=$P(DATA,U,18)
W !!,$P(DFN,U,2)
W !!,"Old Value: ",$S(PGI="":"<no data>",1:PGI),?25,"Last Updated: ",$S(DLU="":"<no data>",1:$$FMTE^XLFDT(DLU))
S $P(^DPT(+DFN,.321),U,17)=$S('PGI:1,1:0),$P(^DPT(+DFN,.321),U,18)=$$NOW^XLFDT
S DATA=$G(^DPT(+DFN,.321))
S PGI=$P(DATA,U,17),DLU=$P(DATA,U,18)
W !,"New Value: ",$S(PGI="":"<no data>",1:PGI),?25,"Last Updated: ",$S(DLU="":"<no data>",1:$$FMTE^XLFDT(DLU)),!
D
. N JOB S JOB=0 F S JOB=$O(^TMP(JOB)) Q:'JOB I $D(^TMP(JOB,"SVC",+DFN)) K ^TMP(JOB,"SVC",+DFN)
I $$FMR("EA","Press <Enter> to continue.")
Q
POST ; add option for test accounts only
I +$$PROD^XUPROD Q
I +$$LU^OR628P(19,"OR PACT ACT") Q
N ERROR,OPT
S OPT(19,"+1,",.01)="OR PACT ACT"
S OPT(19,"+1,",1)="PACT Act Patient Updater"
S OPT(19,"+1,",3.6)=DUZ
S OPT(19,"+1,",4)="R"
S OPT(19,"+1,",10.1)="Patient Updater"
S OPT(19,"+1,",20)="W @IOF"
S OPT(19,"+1,",25)="PATIENT^OR628P"
D UPDATE^DIE("","OPT","","ERROR") I $D(ERROR) X "ZW ERROR"
Q
FMR(DIR,PRM,DEF,HLP,SCR) ;
N DILN,DILOCKTM,DISYS
N DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)=DIR S:$G(PRM)'="" DIR("A")=PRM S:$G(DEF)'="" DIR("B")=DEF S:$G(SCR)'="" DIR("S")=SCR
S X=+DIR("A"),Y=$P(DIR("A"),";",2) S:+X DIR("A")=$$SETSTR(Y,"",X,$L(Y))
I $G(HLP)'="" S DIR("?")=HLP
I $D(HLP)>1 M DIR=HLP
D ^DIR
Q $S(X="@":X,$D(DTOUT):U,$D(DUOUT):U,$D(DIROUT):U,$D(DIRUT):"",1:Y)
GPT() ; ask user for patient
N %H,%I,DIC,DILOCKTM,DISYS,DTOUT,DUOUT,X,Y
S DIC=2,DIC(0)="AEIMQ",DIC("A")=" Select PATIENT NAME: " W ! D ^DIC
Q Y
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN))
SETSTR(S,V,X,L) ;
Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOR628P 2353 printed Sep 23, 2025@20:03:05 Page 2
OR628P ;NA/AJB - Patient Updater for PACT Act ;Nov 06, 2024@12:58:46
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**628**;Dec 17, 1997;Build 13
+2 ;
+3 ; Reference to ^DIC in ICR #10006
+4 ; Reference to FIND1^DIC in ICR #2051
+5 ; Reference to UPDATE^DIE in ICR #2053
+6 ; Reference to ^DIR in ICR #10026
+7 ; Reference to FMTE^XLFDT in ICR #10103
+8 ; Reference to $$NOW^XLFDT in ICR #10103
+9 ; Reference to $$PROD^XUPROD in ICR #4440
+10 ;
+11 QUIT
PATIENT ; update patient data for PACT Act
+1 ; testing only/non-production accounts only
+2 IF +$$PROD^XUPROD
QUIT
+3 NEW DFN
SET DFN=$$GPT
if DFN'>0
QUIT
+4 NEW DATA
SET DATA=$GET(^DPT(+DFN,.321))
+5 NEW PGI,DLU
SET PGI=$PIECE(DATA,U,17)
SET DLU=$PIECE(DATA,U,18)
+6 WRITE !!,$PIECE(DFN,U,2)
+7 WRITE !!,"Old Value: ",$SELECT(PGI="":"<no data>",1:PGI),?25,"Last Updated: ",$SELECT(DLU="":"<no data>",1:$$FMTE^XLFDT(DLU))
+8 SET $PIECE(^DPT(+DFN,.321),U,17)=$SELECT('PGI:1,1:0)
SET $PIECE(^DPT(+DFN,.321),U,18)=$$NOW^XLFDT
+9 SET DATA=$GET(^DPT(+DFN,.321))
+10 SET PGI=$PIECE(DATA,U,17)
SET DLU=$PIECE(DATA,U,18)
+11 WRITE !,"New Value: ",$SELECT(PGI="":"<no data>",1:PGI),?25,"Last Updated: ",$SELECT(DLU="":"<no data>",1:$$FMTE^XLFDT(DLU)),!
+12 Begin DoDot:1
+13 NEW JOB
SET JOB=0
FOR
SET JOB=$ORDER(^TMP(JOB))
if 'JOB
QUIT
IF $DATA(^TMP(JOB,"SVC",+DFN))
KILL ^TMP(JOB,"SVC",+DFN)
End DoDot:1
+14 IF $$FMR("EA","Press <Enter> to continue.")
+15 QUIT
POST ; add option for test accounts only
+1 IF +$$PROD^XUPROD
QUIT
+2 IF +$$LU^OR628P(19,"OR PACT ACT")
QUIT
+3 NEW ERROR,OPT
+4 SET OPT(19,"+1,",.01)="OR PACT ACT"
+5 SET OPT(19,"+1,",1)="PACT Act Patient Updater"
+6 SET OPT(19,"+1,",3.6)=DUZ
+7 SET OPT(19,"+1,",4)="R"
+8 SET OPT(19,"+1,",10.1)="Patient Updater"
+9 SET OPT(19,"+1,",20)="W @IOF"
+10 SET OPT(19,"+1,",25)="PATIENT^OR628P"
+11 DO UPDATE^DIE("","OPT","","ERROR")
IF $DATA(ERROR)
XECUTE "ZW ERROR"
+12 QUIT
FMR(DIR,PRM,DEF,HLP,SCR) ;
+1 NEW DILN,DILOCKTM,DISYS
+2 NEW DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)=DIR
if $GET(PRM)'=""
SET DIR("A")=PRM
if $GET(DEF)'=""
SET DIR("B")=DEF
if $GET(SCR)'=""
SET DIR("S")=SCR
+4 SET X=+DIR("A")
SET Y=$PIECE(DIR("A"),";",2)
if +X
SET DIR("A")=$$SETSTR(Y,"",X,$LENGTH(Y))
+5 IF $GET(HLP)'=""
SET DIR("?")=HLP
+6 IF $DATA(HLP)>1
MERGE DIR=HLP
+7 DO ^DIR
+8 QUIT $SELECT(X="@":X,$DATA(DTOUT):U,$DATA(DUOUT):U,$DATA(DIROUT):U,$DATA(DIRUT):"",1:Y)
GPT() ; ask user for patient
+1 NEW %H,%I,DIC,DILOCKTM,DISYS,DTOUT,DUOUT,X,Y
+2 SET DIC=2
SET DIC(0)="AEIMQ"
SET DIC("A")=" Select PATIENT NAME: "
WRITE !
DO ^DIC
+3 QUIT Y
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN))
SETSTR(S,V,X,L) ;
+1 QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
