DG1010PA ;ALB/REW - 1010 PRINT--INQUIRY PATIENT -ADDITIONL ; 28-MAY-93
;;5.3;Registration;**18,28,86,108,113,570,624**;Aug 13, 1993
;
NOREG(DFN) ; DOES PROMPTS FOR 10/10 PRINT W/O REGISTRATION
;INPUT: DFN
;OUTPUT: VARIABLES NEEDED FOR DIFFERENT PRINTOUTS
; DGMTYPT - MT=1 Copay=2 None=0
; DGOPT - WHICH REPORTS TO PRINT
; DGPMDA - Admissions Report Info
; PRF - FLAG FOR RX PROFILE
; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
; PSTYPE - TYPE OF DRUG PROFILE
; GMTSTYP - TYPE OF HEALTH SUMMARY
; EASMTIEN - Means Test IEN used for EZ/EZR
;
;
N DG1,I,X,Y,FORM
S FREE=+$P(^DG(43,1,0),U,8),DGOPT=""
S PRF=0 G QTNOREG:'$D(^DG(43,1,0)) ;NEED MAS PARAMETERS TO CONTINUE
I $$PROMPRN("THIRD") G:DG1<0 QTNOREG S DGOPT=DGOPT_3
S FORM=$$SEL1010^DG1010P()
S EASMTIEN=$$MTPRMPT^DG1010P(DFN,$G(DGMTI))
I FORM<0 S DG1=-1 G QTNOREG
I FORM="EZ" S DGOPT=DGOPT_0
I FORM="EZR" S DGOPT=DGOPT_1
I $$PROMPRN("HS") G:DG1<0 QTNOREG S DGOPT=DGOPT_8
I $$PROMPRN("PRO") G:DG1<0 QTNOREG S DGOPT=DGOPT_5,PRF=1
QTNOREG S:$G(DG1)<0 DGOPT=""
Q
PROMPRN(DGX) ; PROMPTS FOR PRINT
; RETURNS DGX [1=YES;0=NO;-1=DIRUT CONDITIONS]
; OUTPUT:DG1 VALUE
S DG1=0
I $$FAILCOND(DGX) S DG1=$S($D(DG1):DG1,1:2) G QTPROMP ;DEFAULT=NO
F D Q:$G(DG1)
.S DG1=$$ASK(DGX)
.S:DG1=1 DG1=$$AFTERASK(DGX)
QTPROMP Q $S(DG1=2:0,(DG1=1):1,1:DG1)
ASK(DGX) ; PROMPTS FOR PRINT
;
; RETURNS DGX [2=NO,1=YES;0=?,-1=DIRUT CONDITIONS]
W !,"PRINT "
W $S(DGX="THIRD":"ERROR",(DGX="HS"):"HEALTH SUMMARY",(DGX="PRO"):"DRUG PROFILE",(DGX="EF"):"ENCOUNTER FORMS",1:"ERROR")
S %=1 D YN^DICN I '% W !,"ENTER 'Y'ES TO PRINT A ",DGX,". OTHERWISE ENTER 'N'O."
Q $G(%)
FAILCOND(DGX) ;CHECKS IF PROMPT SHOULD BE ASKED
;
; DGI: 2=NO;1=YES;-1=DIRUT
;RETURNS 1=DON'T ASK AND SKIP TO NEXT;0=ASK
;
N DGFAIL
S DGFAIL=0
I DGX=1010 G QTFAIL
I DGX="THIRD" F D Q:$G(%) G QTFAIL
.N DGNOQ,DGDEF
.D ADM
.S DGFAIL=1
.I DGPMDA>0!$D(^DGS(41.1,"B",DFN)) D
..S (DGNOQ,DGDEF)=1 D ASK^DGBLRV
..S DG1=%
I DGX="HS" S DGFAIL=1 D G QTFAIL
.S X="GMTSDVR" X ^%ZOSF("TEST") I $T D
..S:$T(ENXQ^GMTSDVR)]""&($P(^DG(43,1,0),U,42)) DGFAIL=0
I DGX="PRO" S DGFAIL=1 D G QTFAIL
.S X="PSOSD1" X ^%ZOSF("TEST") I '$T Q
.I '$P(^DG(43,1,0),U,17) Q
.S DGFAIL=0
I DGX="EF" D G QTFAIL
.I $P(^DG(43,1,0),U,47)'=1 S DGFAIL=1 Q
QTFAIL Q DGFAIL
AFTERASK(DGX) ;ACTIONS AFTER REPONSE OF YES TO PRINT
;NOTE: Reports removed from DG REGISTRATION 10/10 REPRINT option are
; remaining to support any outside integrations.
;
; RETURNS DGGO[2=DON'T PRINT,1=PRINT,-1=ABORT]
; SETS PRINT-SETUP VARIABLES
; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
; PSTYPE = DRUG PROFILE TYPE
; GMTSTYP = POINTER TO HEALTH SUMMARY TYPE
;
N DGGO,DIR,X,Y
S DGGO=1
I DGX="HS" D ;HEALTH SUMMARY
.S X=$P($G(^DG(43,1,0)),U,43),DIC=142,DIC(0)="NX"
.D ^DIC K DIC
.S:+Y DIR("B")=$P(Y,U,2)
.S DIR(0)="PO^142:QAMEZ"
.D ^DIR
.I Y'>0 W !,*7,"No Type Selected. HS will not print" S DGGO=2 K DIR,DIRUT,DUOUT Q
.S GMTSTYP=+Y
I DGX="PRO" D ;DRUG PROFILE
.S DGGO=0
.N DGDEF
.S DGDEF=$P(^DG(43,1,0),U,45)
.I $P(^DG(43,1,0),U,44) D
..S:DGDEF]"" DIR("B")=$S(DGDEF="A":"ACTION",(DGDEF="I"):"INFORMATIONAL",1:"")
..S DIR(0)="SM^A:ACTION;I:INFORMATIONAL"
..S DIR("A")="Select type of Drug Profile"
..D ^DIR
..S DGDEF=Y
.I '$D(DIRUT) D
..S (PSOPAR,PSTYPE)=$S(DGDEF="A":1,(DGDEF="I"):0,1:0),(DGGO,PSONOPG)=1
..S PSOINST=+$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),U,17),99)),U)
Q DGGO
ADM K DGPMDA I $D(^DGPM("ATID1",DFN)) F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I!(I>(DFN1+.9999)) S DGPMDA=$O(^(I,0))
S DGPMDA=$S($D(DGPMDA):DGPMDA,1:0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1010PA 4003 printed Dec 13, 2024@02:35:08 Page 2
DG1010PA ;ALB/REW - 1010 PRINT--INQUIRY PATIENT -ADDITIONL ; 28-MAY-93
+1 ;;5.3;Registration;**18,28,86,108,113,570,624**;Aug 13, 1993
+2 ;
NOREG(DFN) ; DOES PROMPTS FOR 10/10 PRINT W/O REGISTRATION
+1 ;INPUT: DFN
+2 ;OUTPUT: VARIABLES NEEDED FOR DIFFERENT PRINTOUTS
+3 ; DGMTYPT - MT=1 Copay=2 None=0
+4 ; DGOPT - WHICH REPORTS TO PRINT
+5 ; DGPMDA - Admissions Report Info
+6 ; PRF - FLAG FOR RX PROFILE
+7 ; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
+8 ; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
+9 ; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
+10 ; PSTYPE - TYPE OF DRUG PROFILE
+11 ; GMTSTYP - TYPE OF HEALTH SUMMARY
+12 ; EASMTIEN - Means Test IEN used for EZ/EZR
+13 ;
+14 ;
+15 NEW DG1,I,X,Y,FORM
+16 SET FREE=+$PIECE(^DG(43,1,0),U,8)
SET DGOPT=""
+17 ;NEED MAS PARAMETERS TO CONTINUE
SET PRF=0
if '$DATA(^DG(43,1,0))
GOTO QTNOREG
+18 IF $$PROMPRN("THIRD")
if DG1<0
GOTO QTNOREG
SET DGOPT=DGOPT_3
+19 SET FORM=$$SEL1010^DG1010P()
+20 SET EASMTIEN=$$MTPRMPT^DG1010P(DFN,$GET(DGMTI))
+21 IF FORM<0
SET DG1=-1
GOTO QTNOREG
+22 IF FORM="EZ"
SET DGOPT=DGOPT_0
+23 IF FORM="EZR"
SET DGOPT=DGOPT_1
+24 IF $$PROMPRN("HS")
if DG1<0
GOTO QTNOREG
SET DGOPT=DGOPT_8
+25 IF $$PROMPRN("PRO")
if DG1<0
GOTO QTNOREG
SET DGOPT=DGOPT_5
SET PRF=1
QTNOREG if $GET(DG1)<0
SET DGOPT=""
+1 QUIT
PROMPRN(DGX) ; PROMPTS FOR PRINT
+1 ; RETURNS DGX [1=YES;0=NO;-1=DIRUT CONDITIONS]
+2 ; OUTPUT:DG1 VALUE
+3 SET DG1=0
+4 ;DEFAULT=NO
IF $$FAILCOND(DGX)
SET DG1=$SELECT($DATA(DG1):DG1,1:2)
GOTO QTPROMP
+5 FOR
Begin DoDot:1
+6 SET DG1=$$ASK(DGX)
+7 if DG1=1
SET DG1=$$AFTERASK(DGX)
End DoDot:1
if $GET(DG1)
QUIT
QTPROMP QUIT $SELECT(DG1=2:0,(DG1=1):1,1:DG1)
ASK(DGX) ; PROMPTS FOR PRINT
+1 ;
+2 ; RETURNS DGX [2=NO,1=YES;0=?,-1=DIRUT CONDITIONS]
+3 WRITE !,"PRINT "
+4 WRITE $SELECT(DGX="THIRD":"ERROR",(DGX="HS"):"HEALTH SUMMARY",(DGX="PRO"):"DRUG PROFILE",(DGX="EF"):"ENCOUNTER FORMS",1:"ERROR")
+5 SET %=1
DO YN^DICN
IF '%
WRITE !,"ENTER 'Y'ES TO PRINT A ",DGX,". OTHERWISE ENTER 'N'O."
+6 QUIT $GET(%)
FAILCOND(DGX) ;CHECKS IF PROMPT SHOULD BE ASKED
+1 ;
+2 ; DGI: 2=NO;1=YES;-1=DIRUT
+3 ;RETURNS 1=DON'T ASK AND SKIP TO NEXT;0=ASK
+4 ;
+5 NEW DGFAIL
+6 SET DGFAIL=0
+7 IF DGX=1010
GOTO QTFAIL
+8 IF DGX="THIRD"
FOR
Begin DoDot:1
+9 NEW DGNOQ,DGDEF
+10 DO ADM
+11 SET DGFAIL=1
+12 IF DGPMDA>0!$DATA(^DGS(41.1,"B",DFN))
Begin DoDot:2
+13 SET (DGNOQ,DGDEF)=1
DO ASK^DGBLRV
+14 SET DG1=%
End DoDot:2
End DoDot:1
if $GET(%)
QUIT
GOTO QTFAIL
+15 IF DGX="HS"
SET DGFAIL=1
Begin DoDot:1
+16 SET X="GMTSDVR"
XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:2
+17 if $TEXT(ENXQ^GMTSDVR)]""&($PIECE(^DG(43,1,0),U,42))
SET DGFAIL=0
End DoDot:2
End DoDot:1
GOTO QTFAIL
+18 IF DGX="PRO"
SET DGFAIL=1
Begin DoDot:1
+19 SET X="PSOSD1"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+20 IF '$PIECE(^DG(43,1,0),U,17)
QUIT
+21 SET DGFAIL=0
End DoDot:1
GOTO QTFAIL
+22 IF DGX="EF"
Begin DoDot:1
+23 IF $PIECE(^DG(43,1,0),U,47)'=1
SET DGFAIL=1
QUIT
End DoDot:1
GOTO QTFAIL
QTFAIL QUIT DGFAIL
AFTERASK(DGX) ;ACTIONS AFTER REPONSE OF YES TO PRINT
+1 ;NOTE: Reports removed from DG REGISTRATION 10/10 REPRINT option are
+2 ; remaining to support any outside integrations.
+3 ;
+4 ; RETURNS DGGO[2=DON'T PRINT,1=PRINT,-1=ABORT]
+5 ; SETS PRINT-SETUP VARIABLES
+6 ; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
+7 ; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
+8 ; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
+9 ; PSTYPE = DRUG PROFILE TYPE
+10 ; GMTSTYP = POINTER TO HEALTH SUMMARY TYPE
+11 ;
+12 NEW DGGO,DIR,X,Y
+13 SET DGGO=1
+14 ;HEALTH SUMMARY
IF DGX="HS"
Begin DoDot:1
+15 SET X=$PIECE($GET(^DG(43,1,0)),U,43)
SET DIC=142
SET DIC(0)="NX"
+16 DO ^DIC
KILL DIC
+17 if +Y
SET DIR("B")=$PIECE(Y,U,2)
+18 SET DIR(0)="PO^142:QAMEZ"
+19 DO ^DIR
+20 IF Y'>0
WRITE !,*7,"No Type Selected. HS will not print"
SET DGGO=2
KILL DIR,DIRUT,DUOUT
QUIT
+21 SET GMTSTYP=+Y
End DoDot:1
+22 ;DRUG PROFILE
IF DGX="PRO"
Begin DoDot:1
+23 SET DGGO=0
+24 NEW DGDEF
+25 SET DGDEF=$PIECE(^DG(43,1,0),U,45)
+26 IF $PIECE(^DG(43,1,0),U,44)
Begin DoDot:2
+27 if DGDEF]""
SET DIR("B")=$SELECT(DGDEF="A":"ACTION",(DGDEF="I"):"INFORMATIONAL",1:"")
+28 SET DIR(0)="SM^A:ACTION;I:INFORMATIONAL"
+29 SET DIR("A")="Select type of Drug Profile"
+30 DO ^DIR
+31 SET DGDEF=Y
End DoDot:2
+32 IF '$DATA(DIRUT)
Begin DoDot:2
+33 SET (PSOPAR,PSTYPE)=$SELECT(DGDEF="A":1,(DGDEF="I"):0,1:0)
SET (DGGO,PSONOPG)=1
+34 SET PSOINST=+$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),U,17),99)),U)
End DoDot:2
End DoDot:1
+35 QUIT DGGO
ADM KILL DGPMDA
IF $DATA(^DGPM("ATID1",DFN))
FOR I=0:0
SET I=$ORDER(^DGPM("ATID1",DFN,I))
if 'I!(I>(DFN1+.9999))
QUIT
SET DGPMDA=$ORDER(^(I,0))
+1 SET DGPMDA=$SELECT($DATA(DGPMDA):DGPMDA,1:0)
+2 QUIT
