- GMPLP37I ; SLC/MKB/KER -- Save Problem List data ; 10/01/2008
- ;;2.0;Problem List;**37**;Aug 25, 1994;Build 1
- ;
- ; External References
- ;
- FIND(ACTION) ;
- N ARRAY,CNT,DAT,IEN,PL,PRI,PT,STAT
- S CNT=0
- S PT=0 F S PT=$O(^PXRMINDX(9000011,"PSPI",PT)) Q:PT'>0 D
- .S STAT=""
- .F S STAT=$O(^PXRMINDX(9000011,"PSPI",PT,STAT)) Q:STAT="" D
- ..I '$D(^PXRMINDX(9000011,"PSPI",PT,STAT,0)) Q
- ..S PL=0
- ..F S PL=$O(^PXRMINDX(9000011,"PSPI",PT,STAT,0,PL)) Q:PL'>0 D
- ...S DAT=0
- ...F S DAT=$O(^PXRMINDX(9000011,"PSPI",PT,STAT,0,PL,DAT)) Q:DAT'>0 D
- ....S IEN=0
- ....F S IEN=$O(^PXRMINDX(9000011,"PSPI",PT,STAT,0,PL,DAT,IEN)) Q:IEN'>0 D
- .....S CNT=CNT+1
- .....I ACTION=1 S ARRAY(CNT)=IEN
- I ACTION=1 D UPD(.ARRAY)
- Q CNT
- ;
- POST ;
- N ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,TEXT,ZTSK
- S ZTDESC="Correction to the Priority field in the PROBLEM file"
- S TEXT=ZTDESC_" has been queued, task number "
- S ZTRTN="QUEUED^GMPLP37I"
- S ZTIO=""
- S ZTDTH=$$NOW^XLFDT
- S ZTREQ="@"
- D ^%ZTLOAD
- I $D(ZTSK) S TEXT=TEXT_ZTSK D MES^XPDUTL(.TEXT)
- Q
- QUEUED ;
- N ARRAY,AFTER,BEFORE,CHANGE,CNT
- S CNT=0
- S BEFORE=$$FIND(0)
- I BEFORE=0 D G SEND
- .S CNT=CNT+1,ARRAY(CNT,0)="No invalid entries found in the PROBLEM file."
- S CNT=CNT+1,ARRAY(CNT,0)="Initial count of invalid entries in the PROBLEM file."
- S CNT=CNT+1,ARRAY(CNT,0)=" "_BEFORE_" Invalid entries in the PROBLEM file."
- S CNT=CNT+1,ARRAY(CNT,0)=" "
- S CHANGE=$$FIND(1)
- S CNT=CNT+1,ARRAY(CNT,0)="Number of entries that were change."
- S CNT=CNT+1,ARRAY(CNT,0)=" "_CHANGE_" entries in the PROBLEM file corrected."
- S CNT=CNT+1,ARRAY(CNT,0)=" "
- S AFTER=$$FIND(0)
- S CNT=CNT+1,ARRAY(CNT,0)="Count of entries that are still invalid."
- S CNT=CNT+1,ARRAY(CNT,0)=" "_AFTER_" Invalid entries in the PROBLEM file."
- ;
- SEND ;mailman
- N NL,XMDUZ,XMY,XMZ
- S XMSUB="Correction of invalid entries in the PROBLEM file"
- S XMDUZ=0.5
- ;
- RETRY ;Get the message number.
- D XMZ^XMA2
- I XMZ<1 G RETRY
- ;
- ;Load the message
- M ^XMB(3.9,XMZ,2)=ARRAY
- S NL=$O(^XMB(3.9,XMZ,2,""),-1)
- S ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
- ;
- ;Send message to USER
- S XMY(DUZ)="" D ENT1^XMD Q
- Q
- ;
- UPD(ARRAY) ;
- N CNT,DA,DIE,DR
- S DIE="^AUPNPROB(",DR="1.14///@"
- S CNT=0 F S CNT=$O(ARRAY(CNT)) Q:CNT'>0 D
- .S DA=ARRAY(CNT)
- .D ^DIE
- Q
- GMPLP37I ; SLC/MKB/KER -- Save Problem List data ; 10/01/2008
- +1 ;;2.0;Problem List;**37**;Aug 25, 1994;Build 1
- +2 ;
- +3 ; External References
- +4 ;
- FIND(ACTION) ;
- +1 NEW ARRAY,CNT,DAT,IEN,PL,PRI,PT,STAT
- +2 SET CNT=0
- +3 SET PT=0
- FOR
- SET PT=$ORDER(^PXRMINDX(9000011,"PSPI",PT))
- IF PT'>0
- QUIT
- Begin DoDot:1
- +4 SET STAT=""
- +5 FOR
- SET STAT=$ORDER(^PXRMINDX(9000011,"PSPI",PT,STAT))
- IF STAT=""
- QUIT
- Begin DoDot:2
- +6 IF '$DATA(^PXRMINDX(9000011,"PSPI",PT,STAT,0))
- QUIT
- +7 SET PL=0
- +8 FOR
- SET PL=$ORDER(^PXRMINDX(9000011,"PSPI",PT,STAT,0,PL))
- IF PL'>0
- QUIT
- Begin DoDot:3
- +9 SET DAT=0
- +10 FOR
- SET DAT=$ORDER(^PXRMINDX(9000011,"PSPI",PT,STAT,0,PL,DAT))
- IF DAT'>0
- QUIT
- Begin DoDot:4
- +11 SET IEN=0
- +12 FOR
- SET IEN=$ORDER(^PXRMINDX(9000011,"PSPI",PT,STAT,0,PL,DAT,IEN))
- IF IEN'>0
- QUIT
- Begin DoDot:5
- +13 SET CNT=CNT+1
- +14 IF ACTION=1
- SET ARRAY(CNT)=IEN
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 IF ACTION=1
- DO UPD(.ARRAY)
- +16 QUIT CNT
- +17 ;
- POST ;
- +1 NEW ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,TEXT,ZTSK
- +2 SET ZTDESC="Correction to the Priority field in the PROBLEM file"
- +3 SET TEXT=ZTDESC_" has been queued, task number "
- +4 SET ZTRTN="QUEUED^GMPLP37I"
- +5 SET ZTIO=""
- +6 SET ZTDTH=$$NOW^XLFDT
- +7 SET ZTREQ="@"
- +8 DO ^%ZTLOAD
- +9 IF $DATA(ZTSK)
- SET TEXT=TEXT_ZTSK
- DO MES^XPDUTL(.TEXT)
- +10 QUIT
- QUEUED ;
- +1 NEW ARRAY,AFTER,BEFORE,CHANGE,CNT
- +2 SET CNT=0
- +3 SET BEFORE=$$FIND(0)
- +4 IF BEFORE=0
- Begin DoDot:1
- +5 SET CNT=CNT+1
- SET ARRAY(CNT,0)="No invalid entries found in the PROBLEM file."
- End DoDot:1
- GOTO SEND
- +6 SET CNT=CNT+1
- SET ARRAY(CNT,0)="Initial count of invalid entries in the PROBLEM file."
- +7 SET CNT=CNT+1
- SET ARRAY(CNT,0)=" "_BEFORE_" Invalid entries in the PROBLEM file."
- +8 SET CNT=CNT+1
- SET ARRAY(CNT,0)=" "
- +9 SET CHANGE=$$FIND(1)
- +10 SET CNT=CNT+1
- SET ARRAY(CNT,0)="Number of entries that were change."
- +11 SET CNT=CNT+1
- SET ARRAY(CNT,0)=" "_CHANGE_" entries in the PROBLEM file corrected."
- +12 SET CNT=CNT+1
- SET ARRAY(CNT,0)=" "
- +13 SET AFTER=$$FIND(0)
- +14 SET CNT=CNT+1
- SET ARRAY(CNT,0)="Count of entries that are still invalid."
- +15 SET CNT=CNT+1
- SET ARRAY(CNT,0)=" "_AFTER_" Invalid entries in the PROBLEM file."
- +16 ;
- SEND ;mailman
- +1 NEW NL,XMDUZ,XMY,XMZ
- +2 SET XMSUB="Correction of invalid entries in the PROBLEM file"
- +3 SET XMDUZ=0.5
- +4 ;
- RETRY ;Get the message number.
- +1 DO XMZ^XMA2
- +2 IF XMZ<1
- GOTO RETRY
- +3 ;
- +4 ;Load the message
- +5 MERGE ^XMB(3.9,XMZ,2)=ARRAY
- +6 SET NL=$ORDER(^XMB(3.9,XMZ,2,""),-1)
- +7 SET ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
- +8 ;
- +9 ;Send message to USER
- +10 SET XMY(DUZ)=""
- DO ENT1^XMD
- QUIT
- +11 QUIT
- +12 ;
- UPD(ARRAY) ;
- +1 NEW CNT,DA,DIE,DR
- +2 SET DIE="^AUPNPROB("
- SET DR="1.14///@"
- +3 SET CNT=0
- FOR
- SET CNT=$ORDER(ARRAY(CNT))
- IF CNT'>0
- QUIT
- Begin DoDot:1
- +4 SET DA=ARRAY(CNT)
- +5 DO ^DIE
- End DoDot:1
- +6 QUIT
