- 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 Mar 13, 2025@21:31:45 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)
